{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Options.DockerParser
( dockerOptsParser
) where
import Data.List ( intercalate )
import qualified Data.Text as T
import Distribution.Version ( anyVersion )
import Options.Applicative
( Parser, auto, completer, help, listCompleter, long, metavar
, option, str, value
)
import Options.Applicative.Args ( argsOption )
import Options.Applicative.Builder.Extra
( dirCompleter, eitherReader', fileCompleter
, firstBoolFlagsFalse, firstBoolFlagsNoDefault
, firstBoolFlagsTrue, optionalFirst
)
import Stack.Docker ( dockerCmdName )
import Stack.Prelude
import Stack.Options.Utils ( hideMods )
import Stack.Types.Version ( IntersectingVersionRange (..) )
import Stack.Types.Docker
( DockerMonoidRepoOrImage (..), DockerOptsMonoid (..)
, dockerAutoPullArgName, dockerImageArgName
, dockerContainerNameArgName, dockerDetachArgName
, dockerEnvArgName, dockerPersistArgName
, dockerRegistryLoginArgName, dockerRegistryPasswordArgName
, dockerRegistryUsernameArgName, dockerRepoArgName
, dockerRunArgsArgName, dockerMountArgName
, dockerMountModeArgName, dockerNetworkArgName
, dockerSetUserArgName, dockerStackExeArgName
, dockerStackExeDownloadVal, dockerStackExeHostVal
, dockerStackExeImageVal, parseDockerStackExe
)
dockerOptsParser :: Bool -> Parser DockerOptsMonoid
dockerOptsParser :: Bool -> Parser DockerOptsMonoid
dockerOptsParser Bool
hide0 = Any
-> First Bool
-> First DockerMonoidRepoOrImage
-> First Bool
-> First String
-> First String
-> FirstTrue
-> FirstFalse
-> FirstFalse
-> First String
-> First String
-> [String]
-> [Mount]
-> First String
-> [String]
-> First DockerStackExe
-> First Bool
-> IntersectingVersionRange
-> DockerOptsMonoid
DockerOptsMonoid (Bool -> Any
Any Bool
False)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
String
dockerCmdName
String
"using a Docker container. --docker implies 'system-ghc: true'"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> First a
First
( forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DockerMonoidRepoOrImage
DockerMonoidRepo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerRepoArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Docker repository name"
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DockerMonoidRepoOrImage
DockerMonoidImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerImageArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IMAGE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Exact Docker image ID (overrides docker-repo)"
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
(Text -> String
dockerOptName Text
dockerRegistryLoginArgName)
String
"registry requires login"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser (First String)
firstStrOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerRegistryUsernameArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"USERNAME"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Docker registry username"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser (First String)
firstStrOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerRegistryPasswordArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PASSWORD"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Docker registry password"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue
(Text -> String
dockerOptName Text
dockerAutoPullArgName)
String
"automatic pulling latest version of image"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse
(Text -> String
dockerOptName Text
dockerDetachArgName)
String
"running a detached Docker container"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse
(Text -> String
dockerOptName Text
dockerPersistArgName)
String
"not deleting container after it exits"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser (First String)
firstStrOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerContainerNameArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Docker container name"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser (First String)
firstStrOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerNetworkArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NETWORK"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Docker network"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [String] -> Parser [String]
argsOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerRunArgsArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value []
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"'ARG1 [ARG2 ...]'"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Additional options to pass to 'docker run'")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerMountArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"(PATH | HOST-PATH:CONTAINER-PATH)"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Mount volumes from host in container (can be specified \
\multiple times)"
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser (First String)
firstStrOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerMountModeArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SUFFIX"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Volume mount mode suffix"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerEnvArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME=VALUE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Set environment variable in container (can be specified \
\multiple times)"
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' forall (m :: * -> *). MonadThrow m => String -> m DockerStackExe
parseDockerStackExe)
( let specialOpts :: [String]
specialOpts = [ String
dockerStackExeDownloadVal
, String
dockerStackExeHostVal
, String
dockerStackExeImageVal
]
in forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
dockerOptName Text
dockerStackExeArgName)
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (forall a. [a] -> [[a]] -> [a]
intercalate String
"|" ([String]
specialOpts forall a. [a] -> [a] -> [a]
++ [String
"PATH"]))
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String]
specialOpts forall a. Semigroup a => a -> a -> a
<> Completer
fileCompleter)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help ( forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Location of "
, String
stackProgName
, String
" executable used in container"
]
)
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
(Text -> String
dockerOptName Text
dockerSetUserArgName)
String
"setting user in container to match host"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionRange -> IntersectingVersionRange
IntersectingVersionRange VersionRange
anyVersion)
where
dockerOptName :: Text -> String
dockerOptName Text
optName = String
dockerCmdName forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
optName
firstStrOption :: Mod OptionFields String -> Parser (First String)
firstStrOption = forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
hide :: Mod f a
hide = forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide0