{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.DockerParser where

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.Docker
import           Stack.Prelude
import           Stack.Options.Utils
import           Stack.Types.Version
import           Stack.Types.Docker

-- | Options parser configuration for Docker.

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 " forall a. [a] -> [a] -> [a]
++
                                 String
"(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 " forall a. [a] -> [a] -> [a]
++
                                      String
"(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