diff --git a/subs/curator/app/Main.hs b/subs/curator/app/Main.hs index 1e114ceb75..354e0d1e9b 100644 --- a/subs/curator/app/Main.hs +++ b/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 diff --git a/subs/curator/package.yaml b/subs/curator/package.yaml index 557378e3bc..a57677fda9 100644 --- a/subs/curator/package.yaml +++ b/subs/curator/package.yaml @@ -9,6 +9,7 @@ dependencies: - yaml - path - path-io +- optparse-generic library: source-dirs: src