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..353195b 100644 --- a/src/haskell/exe/Main.hs +++ b/src/haskell/exe/Main.hs @@ -1,4 +1,196 @@ -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] } + + +data DockerComposeCmd = + Build + | Bundle + | Config + | Create + | Down + | Events + | Exec + | Help + | Images + | Kill + | Logs + | Pause + | Port + | Ps + | Pull + | Push + | Restart + | Rm + | Run + | Scale + | Start + | Stop + | Top + | Unpause + | Up + | Version + deriving (Show) + + + +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) fullDesc) + <> command "repl" (info (pure runRepl) fullDesc) + <> command "exec" (info (pure runExec) fullDesc) + ) + <|> + hsubparser + ( dcParser "build" Build "Build or rebuild services" + <> dcParser "bundle" Bundle "Generate a Docker bundle from the Compose file" + <> dcParser "config" Config "Validate and view the Compose file" + <> dcParser "create" Create "Create services" + <> dcParser "down" Down "Stop and remove containers, networks, images, and volumes" + <> dcParser "events" Events "Receive real time events from containers" + <> dcParser "exec" Exec "Execute a command in a running container" + <> dcParser "help" Help "Get help on a command" + <> dcParser "images" Images "List images" + <> dcParser "kill" Kill "Kill containers" + <> dcParser "logs" Logs "View output from containers" + <> dcParser "pause" Pause "Pause services" + <> dcParser "port" Port "Print the public port for a port binding" + <> dcParser "ps" Ps "List containers" + <> dcParser "pull" Pull "Pull service images" + <> dcParser "push" Push "Push service images" + <> dcParser "restart" Restart "Restart services" + <> dcParser "rm" Rm "Remove stopped containers" + <> dcParser "run" Run "Run a one-off command" + <> dcParser "scale" Scale "Set number of containers for a service" + <> dcParser "start" Start "Start services" + <> dcParser "stop" Stop "services" + <> dcParser "top" Top "Display the running processes" + <> dcParser "unpause" Unpause "Unpause services" + <> dcParser "up" Up "Create and start containers" + <> dcParser "version" Version "Show the Docker-Compose version information" + + <> metavar "DOCKER-COMPOSE-COMMAND" + <> commandGroup "Docker Compose Commands:" + ) + + +dcParser + :: Text + -> DockerComposeCmd + -> Text + -> Mod CommandFields (CommonOptions -> IO ()) +dcParser cmdStr cmd help = + command + (T.unpack cmdStr) + (info + (runDockerCompose <$> pure cmd <*> parseDockerComposeArgs) + (progDesc (T.unpack help) <> fullDesc <> forwardOptions)) + + +parseAll :: Parser (IO ()) +parseAll = + flip ($) <$> parseOptions <*> parseCommand + + +parseDockerComposeArgs :: Parser DockerComposeArgs +parseDockerComposeArgs = + DockerComposeArgs <$> + many (argument (T.pack <$> str) (metavar "DOCKER-COMPOSE ARGS...")) + + +shouldEval :: DockerComposeCmd -> Bool +shouldEval Up = True +shouldEval Down = True + + +runDockerCompose :: DockerComposeCmd -> DockerComposeArgs -> CommonOptions -> IO () +runDockerCompose cmd args opts = T.putStrLn (show cmd) + + +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" + + +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 <> " ]" + main :: IO () -main = putStrLn "Hello, Haskell!" +main = + (join . execParser) (info (parseAll <**> helper) fullDesc) +