Add basic command line parsing
This commit is contained in:
Stefan Matting
parent
01f73e486b
commit
9b047987ae
4 changed files with 209 additions and 2 deletions
|
|
@ -19,6 +19,7 @@ write-ghc-enviroment-files:
|
|||
common deps
|
||||
build-depends: base ^>=4.12.0.0
|
||||
, aeson
|
||||
, text
|
||||
, protolude
|
||||
|
||||
|
||||
|
|
|
|||
13
live-check
Executable file
13
live-check
Executable file
|
|
@ -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 \
|
||||
;
|
||||
|
|
@ -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 \
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue