module Distribution.Client.ReplFlags (EnvFlags (..), ReplFlags (..), topReplOptions, multiReplOption, defaultReplFlags) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.Setup
( liftOptions
)
import Distribution.Parsec
( parsecCommaList
)
import Distribution.ReadE
( ReadE
, parsecToReadE
)
import Distribution.Simple.Command
( OptionField
, ShowOrParseArgs
, liftOption
, option
, reqArg
)
import Distribution.Simple.Setup
( Flag (..)
, ReplOptions (..)
, boolOpt
, falseArg
, replOptions
, toFlag
, trueArg
)
import Distribution.Types.Dependency
( Dependency (..)
)
data EnvFlags = EnvFlags
{ EnvFlags -> [Dependency]
envPackages :: [Dependency]
, EnvFlags -> Flag Bool
envIncludeTransitive :: Flag Bool
}
instance Semigroup EnvFlags where
(EnvFlags [Dependency]
a1 Flag Bool
a2) <> :: EnvFlags -> EnvFlags -> EnvFlags
<> (EnvFlags [Dependency]
b1 Flag Bool
b2) = [Dependency] -> Flag Bool -> EnvFlags
EnvFlags ([Dependency]
a1 [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<> [Dependency]
b1) (Flag Bool
a2 Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> Flag Bool
b2)
instance Monoid EnvFlags where
mempty :: EnvFlags
mempty = EnvFlags
defaultEnvFlags
defaultEnvFlags :: EnvFlags
defaultEnvFlags :: EnvFlags
defaultEnvFlags =
EnvFlags
{ envPackages :: [Dependency]
envPackages = []
, envIncludeTransitive :: Flag Bool
envIncludeTransitive = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
}
data ReplFlags = ReplFlags
{ ReplFlags -> ReplOptions
configureReplOptions :: ReplOptions
, ReplFlags -> EnvFlags
replEnvFlags :: EnvFlags
, ReplFlags -> Flag Bool
replUseMulti :: Flag Bool
, ReplFlags -> Flag Bool
replKeepTempFiles :: Flag Bool
}
instance Semigroup ReplFlags where
(ReplFlags ReplOptions
a1 EnvFlags
a2 Flag Bool
a3 Flag Bool
a4) <> :: ReplFlags -> ReplFlags -> ReplFlags
<> (ReplFlags ReplOptions
b1 EnvFlags
b2 Flag Bool
b3 Flag Bool
b4) = ReplOptions -> EnvFlags -> Flag Bool -> Flag Bool -> ReplFlags
ReplFlags (ReplOptions
a1 ReplOptions -> ReplOptions -> ReplOptions
forall a. Semigroup a => a -> a -> a
<> ReplOptions
b1) (EnvFlags
a2 EnvFlags -> EnvFlags -> EnvFlags
forall a. Semigroup a => a -> a -> a
<> EnvFlags
b2) (Flag Bool
a3 Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> Flag Bool
b3) (Flag Bool
a4 Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> Flag Bool
b4)
instance Monoid ReplFlags where
mempty :: ReplFlags
mempty = ReplFlags
defaultReplFlags
defaultReplFlags :: ReplFlags
defaultReplFlags :: ReplFlags
defaultReplFlags =
ReplFlags
{ configureReplOptions :: ReplOptions
configureReplOptions = ReplOptions
forall a. Monoid a => a
mempty
, replEnvFlags :: EnvFlags
replEnvFlags = EnvFlags
defaultEnvFlags
, replUseMulti :: Flag Bool
replUseMulti = Flag Bool
forall a. Flag a
NoFlag
, replKeepTempFiles :: Flag Bool
replKeepTempFiles = Flag Bool
forall a. Flag a
NoFlag
}
topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags]
topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags]
topReplOptions ShowOrParseArgs
showOrParseArgs =
(ReplFlags -> ReplOptions)
-> (ReplOptions -> ReplFlags -> ReplFlags)
-> [OptionField ReplOptions]
-> [OptionField ReplFlags]
forall b a.
(b -> a) -> (a -> b -> b) -> [OptionField a] -> [OptionField b]
liftOptions ReplFlags -> ReplOptions
configureReplOptions ReplOptions -> ReplFlags -> ReplFlags
set1 (ShowOrParseArgs -> [OptionField ReplOptions]
replOptions ShowOrParseArgs
showOrParseArgs)
[OptionField ReplFlags]
-> [OptionField ReplFlags] -> [OptionField ReplFlags]
forall a. [a] -> [a] -> [a]
++ (ReplFlags -> EnvFlags)
-> (EnvFlags -> ReplFlags -> ReplFlags)
-> [OptionField EnvFlags]
-> [OptionField ReplFlags]
forall b a.
(b -> a) -> (a -> b -> b) -> [OptionField a] -> [OptionField b]
liftOptions ReplFlags -> EnvFlags
replEnvFlags EnvFlags -> ReplFlags -> ReplFlags
set2 (ShowOrParseArgs -> [OptionField EnvFlags]
envOptions ShowOrParseArgs
showOrParseArgs)
[OptionField ReplFlags]
-> [OptionField ReplFlags] -> [OptionField ReplFlags]
forall a. [a] -> [a] -> [a]
++ [ (ReplFlags -> Flag Bool)
-> (Flag Bool -> ReplFlags -> ReplFlags)
-> OptionField (Flag Bool)
-> OptionField ReplFlags
forall b a.
(b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
liftOption ReplFlags -> Flag Bool
replUseMulti Flag Bool -> ReplFlags -> ReplFlags
set3 OptionField (Flag Bool)
multiReplOption
,
SFlags
-> LFlags
-> SFlags
-> (ReplFlags -> Flag Bool)
-> (Flag Bool -> ReplFlags -> ReplFlags)
-> MkOptDescr
(ReplFlags -> Flag Bool)
(Flag Bool -> ReplFlags -> ReplFlags)
ReplFlags
-> OptionField ReplFlags
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
[]
[SFlags
"keep-temp-files"]
SFlags
"Keep temporary files"
ReplFlags -> Flag Bool
replKeepTempFiles
(\Flag Bool
b ReplFlags
flags -> ReplFlags
flags{replKeepTempFiles = b})
MkOptDescr
(ReplFlags -> Flag Bool)
(Flag Bool -> ReplFlags -> ReplFlags)
ReplFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
]
where
set1 :: ReplOptions -> ReplFlags -> ReplFlags
set1 ReplOptions
a ReplFlags
x = ReplFlags
x{configureReplOptions = a}
set2 :: EnvFlags -> ReplFlags -> ReplFlags
set2 EnvFlags
a ReplFlags
x = ReplFlags
x{replEnvFlags = a}
set3 :: Flag Bool -> ReplFlags -> ReplFlags
set3 Flag Bool
a ReplFlags
x = ReplFlags
x{replUseMulti = a}
multiReplOption :: OptionField (Flag Bool)
multiReplOption :: OptionField (Flag Bool)
multiReplOption =
SFlags
-> LFlags
-> SFlags
-> (Flag Bool -> Flag Bool)
-> (Flag Bool -> Flag Bool -> Flag Bool)
-> MkOptDescr
(Flag Bool -> Flag Bool)
(Flag Bool -> Flag Bool -> Flag Bool)
(Flag Bool)
-> OptionField (Flag Bool)
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
[]
[SFlags
"multi-repl"]
SFlags
"multi-component repl sessions"
Flag Bool -> Flag Bool
forall a. a -> a
id
(\Flag Bool
v Flag Bool
_ -> Flag Bool
v)
(SFlags
-> SFlags
-> MkOptDescr
(Flag Bool -> Flag Bool)
(Flag Bool -> Flag Bool -> Flag Bool)
(Flag Bool)
forall a.
SFlags
-> SFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt [] [])
envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
envOptions ShowOrParseArgs
_ =
[ SFlags
-> LFlags
-> SFlags
-> (EnvFlags -> [Dependency])
-> ([Dependency] -> EnvFlags -> EnvFlags)
-> MkOptDescr
(EnvFlags -> [Dependency])
([Dependency] -> EnvFlags -> EnvFlags)
EnvFlags
-> OptionField EnvFlags
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
[Char
'b']
[SFlags
"build-depends"]
SFlags
"Include additional packages in the environment presented to GHCi."
EnvFlags -> [Dependency]
envPackages
(\[Dependency]
p EnvFlags
flags -> EnvFlags
flags{envPackages = p ++ envPackages flags})
(SFlags
-> ReadE [Dependency]
-> ([Dependency] -> LFlags)
-> MkOptDescr
(EnvFlags -> [Dependency])
([Dependency] -> EnvFlags -> EnvFlags)
EnvFlags
forall b a.
Monoid b =>
SFlags
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg SFlags
"DEPENDENCIES" ReadE [Dependency]
dependenciesReadE ((Dependency -> SFlags) -> [Dependency] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dependency -> SFlags
forall a. Pretty a => a -> SFlags
prettyShow :: [Dependency] -> [String]))
, SFlags
-> LFlags
-> SFlags
-> (EnvFlags -> Flag Bool)
-> (Flag Bool -> EnvFlags -> EnvFlags)
-> MkOptDescr
(EnvFlags -> Flag Bool)
(Flag Bool -> EnvFlags -> EnvFlags)
EnvFlags
-> OptionField EnvFlags
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
[]
[SFlags
"no-transitive-deps"]
SFlags
"Don't automatically include transitive dependencies of requested packages."
EnvFlags -> Flag Bool
envIncludeTransitive
(\Flag Bool
p EnvFlags
flags -> EnvFlags
flags{envIncludeTransitive = p})
MkOptDescr
(EnvFlags -> Flag Bool)
(Flag Bool -> EnvFlags -> EnvFlags)
EnvFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
falseArg
]
where
dependenciesReadE :: ReadE [Dependency]
dependenciesReadE :: ReadE [Dependency]
dependenciesReadE =
(SFlags -> SFlags)
-> ParsecParser [Dependency] -> ReadE [Dependency]
forall a. (SFlags -> SFlags) -> ParsecParser a -> ReadE a
parsecToReadE
(SFlags
"couldn't parse dependencies: " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++)
(ParsecParser Dependency -> ParsecParser [Dependency]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList ParsecParser Dependency
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Dependency
parsec)