{-# 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
                   )

-- | 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 (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