diff --git a/arion-compose.cabal b/arion-compose.cabal index 825b04c..eb631c0 100644 --- a/arion-compose.cabal +++ b/arion-compose.cabal @@ -19,6 +19,7 @@ write-ghc-enviroment-files: common deps build-depends: base ^>=4.12.0.0 , aeson + , text , protolude diff --git a/live-check b/live-check new file mode 100755 index 0000000..d7cbfb2 --- /dev/null +++ b/live-check @@ -0,0 +1,13 @@ +#!/usr/bin/env nix-shell +#!nix-shell ./shell.nix +#!nix-shell -i bash +set -eux -o pipefail + +cd "$(dirname "${BASH_SOURCE[0]}")" + +ghcid \ + --command 'ghci -isrc/haskell/exe src/haskell/exe/Main.hs' \ + --reload=src/haskell \ + --restart=hercules-ci-api.cabal \ + --restart=../stack.yaml \ + ; diff --git a/live-unit-tests b/live-unit-tests index 4a2cc6c..09e3af9 100755 --- a/live-unit-tests +++ b/live-unit-tests @@ -8,6 +8,7 @@ cd "$(dirname "${BASH_SOURCE[0]}")" ghcid \ --command 'ghci -isrc/haskell/exe -isrc/haskell/lib -isrc/haskell/test src/haskell/test/TestMain.hs' \ --test=Main.main \ + --reload=src/haskell \ --restart=hercules-ci-api.cabal \ --restart=../stack.yaml \ ; diff --git a/src/haskell/exe/Main.hs b/src/haskell/exe/Main.hs index 65ae4a0..fe4f608 100644 --- a/src/haskell/exe/Main.hs +++ b/src/haskell/exe/Main.hs @@ -1,4 +1,165 @@ -module Main where +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE OverloadedStrings #-} + +import Protolude hiding (Down) + +import Options.Applicative +import Control.Applicative + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) + +import Control.Arrow ((>>>)) + +data CommonOptions = + CommonOptions + { files :: NonEmpty FilePath + , pkgs :: Text + } + deriving (Show) + +newtype DockerComposeArgs = + DockerComposeArgs { unDockerComposeArgs :: [Text] } + +ensureConfigFile :: [FilePath] -> NonEmpty FilePath +ensureConfigFile [] = "./arion-compose.nix" :| [] +ensureConfigFile (x:xs) = x :| xs + +parseOptions :: Parser CommonOptions +parseOptions = do + files <- + ensureConfigFile <$> + many (strOption + ( short 'f' + <> long "file" + <> metavar "FILE" + <> help "Use FILE instead of the default ./arion-compose.nix. \ + \Can be specified multiple times for a merged configuration" )) + pkgs <- T.pack <$> strOption + ( short 'p' + <> long "pkgs" + <> metavar "EXPR" + <> showDefault + <> value "./arion-pkgs.nix" + <> help "Use EXPR to get the Nixpkgs attrset used for bootstrapping \ + \and evaluating the configuration." ) + pure CommonOptions{..} + +parseCommand :: Parser (CommonOptions -> IO ()) +parseCommand = + hsubparser + ( command "cat" (info (pure runCat) (progDesc "TODO: cat doc" <> fullDesc)) + <> command "repl" (info (pure runRepl) (progDesc "TODO: repl doc" <> fullDesc)) + <> command "exec" (info (pure runExec) (progDesc "TODO: exec doc" <> fullDesc)) + ) + <|> + hsubparser + ( commandDC runBuildAndDC "build" "Build or rebuild services" + <> commandDC runBuildAndDC "bundle" "Generate a Docker bundle from the Compose file" + <> commandDC runEvalAndDC "config" "Validate and view the Compose file" + <> commandDC runBuildAndDC "create" "Create services" + <> commandDC runEvalAndDC "down" "Stop and remove containers, networks, images, and volumes" + <> commandDC runEvalAndDC "events" "Receive real time events from containers" + <> commandDC runEvalAndDC "exec" "Execute a command in a running container" + <> commandDC runDC "help" "Get help on a command" + <> commandDC runEvalAndDC "images" "List images" + <> commandDC runEvalAndDC "kill" "Kill containers" + <> commandDC runEvalAndDC "logs" "View output from containers" + <> commandDC runEvalAndDC "pause" "Pause services" + <> commandDC runEvalAndDC "port" "Print the public port for a port binding" + <> commandDC runEvalAndDC "ps" "List containers" + <> commandDC runBuildAndDC "pull" "Pull service images" + <> commandDC runBuildAndDC "push" "Push service images" + <> commandDC runBuildAndDC "restart" "Restart services" + <> commandDC runEvalAndDC "rm" "Remove stopped containers" + <> commandDC runBuildAndDC "run" "Run a one-off command" + <> commandDC runBuildAndDC "scale" "Set number of containers for a service" + <> commandDC runBuildAndDC "start" "Start services" + <> commandDC runEvalAndDC "stop" "Stop services" + <> commandDC runEvalAndDC "top" "Display the running processes" + <> commandDC runEvalAndDC "unpause" "Unpause services" + <> commandDC runBuildAndDC "up" "Create and start containers" + <> commandDC runDC "version" "Show the Docker-Compose version information" + + <> metavar "DOCKER-COMPOSE-COMMAND" + <> commandGroup "Docker Compose Commands:" + ) + +parseAll :: Parser (IO ()) +parseAll = + flip ($) <$> parseOptions <*> parseCommand + +parseDockerComposeArgs :: Parser DockerComposeArgs +parseDockerComposeArgs = + DockerComposeArgs <$> + many (argument (T.pack <$> str) (metavar "DOCKER-COMPOSE ARGS...")) + +commandDC + :: (Text -> DockerComposeArgs -> CommonOptions -> IO ()) + -> Text + -> Text + -> Mod CommandFields (CommonOptions -> IO ()) +commandDC run cmdStr help = + command + (T.unpack cmdStr) + (info + (run cmdStr <$> parseDockerComposeArgs) + (progDesc (T.unpack help) <> fullDesc <> forwardOptions)) + +-------------------------------------------------------------------------------- + +modulesNixExpr :: NonEmpty FilePath -> Text +modulesNixExpr = + NE.toList + >>> fmap pathExpr + >>> T.unwords + >>> wrapList + where + pathExpr path | isAbsolute path = "(/. + \"" <> T.pack path <> "\")" + | otherwise = "(./. + \"" <> T.pack path <> "\")" + + isAbsolute ('/':_) = True + isAbsolute _ = False + + wrapList s = "[ " <> s <> " ]" + +-------------------------------------------------------------------------------- + +runDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () +runDC cmd (DockerComposeArgs args) opts = + T.putStrLn $ "TODO: docker-compose " <> cmd <> " " <> T.unwords args + +runBuildAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () +runBuildAndDC cmd dopts opts = do + T.putStrLn "TODO: build" + runDC cmd dopts opts + +runEvalAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () +runEvalAndDC cmd dopts opts = do + T.putStrLn "TODO: eval" + runDC cmd dopts opts + +runCat :: CommonOptions -> IO () +runCat (CommonOptions files pkgs) = do + T.putStrLn "Running cat ... TODO" + T.putStrLn (modulesNixExpr files) + +runRepl :: CommonOptions -> IO () +runRepl opts = + T.putStrLn "Running repl ... TODO" + +runExec :: CommonOptions -> IO () +runExec opts = + T.putStrLn "Running exec ... TODO" main :: IO () -main = putStrLn "Hello, Haskell!" +main = + (join . execParser) (info (parseAll <**> helper) fullDesc) + where + execParser = customExecParser (prefs showHelpOnEmpty) +