module Stack.Options.DockerParser where
import Data.Char
import Data.List (intercalate)
import qualified Data.Text as T
import Distribution.Version (anyVersion)
import Options.Applicative
import Options.Applicative.Args
import Options.Applicative.Builder.Extra
import Stack.Constants
import Stack.Docker
import qualified Stack.Docker as Docker
import Stack.Prelude
import Stack.Options.Utils
import Stack.Types.Version
import Stack.Types.Docker
dockerOptsParser :: Bool -> Parser DockerOptsMonoid
dockerOptsParser hide0 =
DockerOptsMonoid
<$> pure (Any False)
<*> firstBoolFlags dockerCmdName
"using a Docker container. --docker implies 'system-ghc: true'"
hide
<*> fmap First
((Just . DockerMonoidRepo) <$> option str (long (dockerOptName dockerRepoArgName) <>
hide <>
metavar "NAME" <>
help "Docker repository name") <|>
(Just . DockerMonoidImage) <$> option str (long (dockerOptName dockerImageArgName) <>
hide <>
metavar "IMAGE" <>
help "Exact Docker image ID (overrides docker-repo)") <|>
pure Nothing)
<*> firstBoolFlags (dockerOptName dockerRegistryLoginArgName)
"registry requires login"
hide
<*> firstStrOption (long (dockerOptName dockerRegistryUsernameArgName) <>
hide <>
metavar "USERNAME" <>
help "Docker registry username")
<*> firstStrOption (long (dockerOptName dockerRegistryPasswordArgName) <>
hide <>
metavar "PASSWORD" <>
help "Docker registry password")
<*> firstBoolFlags (dockerOptName dockerAutoPullArgName)
"automatic pulling latest version of image"
hide
<*> firstBoolFlags (dockerOptName dockerDetachArgName)
"running a detached Docker container"
hide
<*> firstBoolFlags (dockerOptName dockerPersistArgName)
"not deleting container after it exits"
hide
<*> firstStrOption (long (dockerOptName dockerContainerNameArgName) <>
hide <>
metavar "NAME" <>
help "Docker container name")
<*> argsOption (long (dockerOptName dockerRunArgsArgName) <>
hide <>
value [] <>
metavar "'ARG1 [ARG2 ...]'" <>
help "Additional options to pass to 'docker run'")
<*> many (option auto (long (dockerOptName dockerMountArgName) <>
hide <>
metavar "(PATH | HOST-PATH:CONTAINER-PATH)" <>
completer dirCompleter <>
help ("Mount volumes from host in container " ++
"(may specify multiple times)")))
<*> many (option str (long (dockerOptName dockerEnvArgName) <>
hide <>
metavar "NAME=VALUE" <>
help ("Set environment variable in container " ++
"(may specify multiple times)")))
<*> optionalFirst (absFileOption
(long (dockerOptName dockerDatabasePathArgName) <>
hide <>
metavar "PATH" <>
help "Location of image usage tracking database"))
<*> optionalFirst (option (eitherReader' parseDockerStackExe)
(let specialOpts =
[ dockerStackExeDownloadVal
, dockerStackExeHostVal
, dockerStackExeImageVal
] in
long(dockerOptName dockerStackExeArgName) <>
hide <>
metavar (intercalate "|" (specialOpts ++ ["PATH"])) <>
completer (listCompleter specialOpts <> fileCompleter) <>
help (concat [ "Location of "
, stackProgName
, " executable used in container" ])))
<*> firstBoolFlags (dockerOptName dockerSetUserArgName)
"setting user in container to match host"
hide
<*> pure (IntersectingVersionRange anyVersion)
where
dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName
firstStrOption = optionalFirst . option str
hide = hideMods hide0
dockerCleanupOptsParser :: Parser Docker.CleanupOpts
dockerCleanupOptsParser =
Docker.CleanupOpts <$>
(flag' Docker.CleanupInteractive
(short 'i' <>
long "interactive" <>
help "Show cleanup plan in editor and allow changes (default)") <|>
flag' Docker.CleanupImmediate
(short 'y' <>
long "immediate" <>
help "Immediately execute cleanup plan") <|>
flag' Docker.CleanupDryRun
(short 'n' <>
long "dry-run" <>
help "Display cleanup plan but do not execute") <|>
pure Docker.CleanupInteractive) <*>
opt (Just 14) "known-images" "LAST-USED" <*>
opt Nothing "unknown-images" "CREATED" <*>
opt (Just 0) "dangling-images" "CREATED" <*>
opt Nothing "stopped-containers" "CREATED" <*>
opt Nothing "running-containers" "CREATED"
where opt def' name mv =
fmap Just
(option auto
(long name <>
metavar (mv ++ "-DAYS-AGO") <>
help ("Remove " ++
toDescr name ++
" " ++
map toLower (toDescr mv) ++
" N days ago" ++
case def' of
Just n -> " (default " ++ show n ++ ")"
Nothing -> ""))) <|>
flag' Nothing
(long ("no-" ++ name) <>
help ("Do not remove " ++
toDescr name ++
case def' of
Just _ -> ""
Nothing -> " (default)")) <|>
pure def'
toDescr = map (\c -> if c == '-' then ' ' else c)