curator CLI

subs/curator/app/Main.hs

@@ -1,52 +1,113 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-import Curator
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+import Curator hiding (Snapshot)
 import Data.Yaml (encodeFile, decodeFileThrow)
+import Options.Generic (ParseRecord, getRecord)
 import Path.IO (resolveFile', resolveDir')
 import RIO.Process
+import qualified Curator
+
+data CuratorOptions
+  = Update
+  | Constraints
+  | SnapshotIncomplete
+  | Snapshot
+  | Unpack
+  | Build
+  deriving (Eq, Show, Generic)
+
+instance ParseRecord CuratorOptions
 
 main :: IO ()
-main = runPantryApp $ do
-  -- each of these should be separate commands
-
-  -- update Hackage index
-  do
-    void $ updateHackageIndex $ Just "Running snapshot curator tool"
-
-  -- write constraints
-  do
-    logInfo "Writing constraints.yaml"
-    loadStackageConstraints "build-constraints.yaml" >>= liftIO . encodeFile "constraints.yaml"
-
-  -- create snapshot
-  do
-    logInfo "Writing snapshot-incomplete.yaml"
-    decodeFileThrow "constraints.yaml" >>= \constraints ->
-      makeSnapshot constraints "my-test-snapshot" >>=
-      liftIO . encodeFile "snapshot-incomplete.yaml"
-
-  -- complete snapshot
-  do
-    logInfo "Writing snapshot.yaml"
-    incomplete <- loadPantrySnapshotFile "snapshot-incomplete.yaml"
-    complete <- completeSnapshot incomplete
-    liftIO $ encodeFile "snapshot.yaml" complete
-
-  do
-    logInfo "Unpacking files"
-    snapshot <- loadPantrySnapshotFile "snapshot.yaml"
-    constraints <- decodeFileThrow "constraints.yaml"
-    dest <- resolveDir' "unpack-dir"
-    unpackSnapshot constraints snapshot dest
-
-  do
-    logInfo "Building"
-    withWorkingDir "unpack-dir" $ proc 
-      "stack"
-      (words "build --test --bench --no-rerun-tests --no-run-benchmarks --haddock")
-      runProcess_
-
-loadPantrySnapshotFile :: FilePath -> RIO PantryApp Snapshot
+main = runPantryApp $
+  getRecord "curator" >>= \case
+    Update ->
+      updateHackageIndexCommand
+    Constraints ->
+      constraintsCommand
+    SnapshotIncomplete ->
+      snapshotIncompleteCommand
+    Snapshot ->
+      snapshotCommand
+    Unpack ->
+      unpackFilesCommand
+    Build ->
+      buildCommand
+
+updateHackageIndexCommand :: RIO PantryApp ()
+updateHackageIndexCommand = do
+  updateHackageIndexStep
+
+constraintsCommand :: RIO PantryApp ()
+constraintsCommand = do
+  updateHackageIndexCommand
+  constraintsStep
+
+snapshotIncompleteCommand :: RIO PantryApp ()
+snapshotIncompleteCommand = do
+  constraintsCommand
+  snapshotIncompleteStep
+
+snapshotCommand :: RIO PantryApp ()
+snapshotCommand = do
+  snapshotIncompleteCommand
+  snapshotStep
+
+unpackFilesCommand :: RIO PantryApp ()
+unpackFilesCommand = do
+  snapshotCommand
+  unpackFilesStep
+
+buildCommand :: RIO PantryApp ()
+buildCommand = do
+  unpackFilesCommand
+  buildStep
+
+updateHackageIndexStep :: RIO PantryApp ()
+updateHackageIndexStep = do
+  void $ updateHackageIndex $ Just "Running snapshot curator tool"
+
+constraintsStep :: RIO PantryApp ()
+constraintsStep = do
+  logInfo "Writing constraints.yaml"
+  loadStackageConstraints "build-constraints.yaml" >>= liftIO . encodeFile "constraints.yaml"
+
+snapshotIncompleteStep :: RIO PantryApp ()
+snapshotIncompleteStep = do
+  logInfo "Writing snapshot-incomplete.yaml"
+  decodeFileThrow "constraints.yaml" >>= \constraints ->
+    makeSnapshot constraints "my-test-snapshot-2" >>=
+    liftIO . encodeFile "snapshot-incomplete.yaml"
+
+snapshotStep :: RIO PantryApp ()
+snapshotStep = do
+  logInfo "Writing snapshot.yaml"
+  incomplete <- loadPantrySnapshotFile "snapshot-incomplete.yaml"
+  complete <- completeSnapshot incomplete
+  liftIO $ encodeFile "snapshot.yaml" complete
+
+unpackFilesStep :: RIO PantryApp ()
+unpackFilesStep = do
+  logInfo "Unpacking files"
+  snapshot <- loadPantrySnapshotFile "snapshot.yaml"
+  constraints <- decodeFileThrow "constraints.yaml"
+  dest <- resolveDir' "unpack-dir"
+  unpackSnapshot constraints snapshot dest
+
+buildStep :: RIO PantryApp ()
+buildStep = do
+  logInfo "Building"
+  withWorkingDir "unpack-dir" $ proc
+    "stack"
+    (words "build --test --bench --no-rerun-tests --no-run-benchmarks --haddock")
+    runProcess_
+
+loadPantrySnapshotFile :: FilePath -> RIO PantryApp Curator.Snapshot
 loadPantrySnapshotFile fp = do
   abs' <- resolveFile' fp
   eres <- loadPantrySnapshot $ SLFilePath (ResolvedPath (RelFilePath (fromString fp)) abs') Nothing

subs/curator/package.yaml

@@ -9,6 +9,7 @@ dependencies:
 - yaml
 - path
 - path-io
+- optparse-generic
 
 library:
   source-dirs: src