module Options.Applicative.Builder.Internal (
Mod(..),
HasName(..),
HasCompleter(..),
HasValue(..),
HasMetavar(..),
OptionFields(..),
FlagFields(..),
CommandFields(..),
ArgumentFields(..),
DefaultProp(..),
optionMod,
fieldMod,
baseProps,
mkCommand,
mkParser,
mkOption,
mkProps,
internal,
noGlobal
) where
import Control.Applicative
import Control.Monad (mplus)
import Data.Semigroup hiding (Option)
import Prelude
import Options.Applicative.Common
import Options.Applicative.Types
data OptionFields a = OptionFields
{ forall a. OptionFields a -> [OptName]
optNames :: [OptName]
, forall a. OptionFields a -> Completer
optCompleter :: Completer
, forall a. OptionFields a -> String -> ParseError
optNoArgError :: String -> ParseError }
data FlagFields a = FlagFields
{ forall a. FlagFields a -> [OptName]
flagNames :: [OptName]
, forall a. FlagFields a -> a
flagActive :: a }
data CommandFields a = CommandFields
{ forall a. CommandFields a -> [(String, ParserInfo a)]
cmdCommands :: [(String, ParserInfo a)]
, forall a. CommandFields a -> Maybe String
cmdGroup :: Maybe String }
data ArgumentFields a = ArgumentFields
{ forall a. ArgumentFields a -> Completer
argCompleter :: Completer }
class HasName f where
name :: OptName -> f a -> f a
instance HasName OptionFields where
name :: forall a. OptName -> OptionFields a -> OptionFields a
name OptName
n OptionFields a
fields = OptionFields a
fields { optNames :: [OptName]
optNames = OptName
n forall a. a -> [a] -> [a]
: forall a. OptionFields a -> [OptName]
optNames OptionFields a
fields }
instance HasName FlagFields where
name :: forall a. OptName -> FlagFields a -> FlagFields a
name OptName
n FlagFields a
fields = FlagFields a
fields { flagNames :: [OptName]
flagNames = OptName
n forall a. a -> [a] -> [a]
: forall a. FlagFields a -> [OptName]
flagNames FlagFields a
fields }
class HasCompleter f where
modCompleter :: (Completer -> Completer) -> f a -> f a
instance HasCompleter OptionFields where
modCompleter :: forall a.
(Completer -> Completer) -> OptionFields a -> OptionFields a
modCompleter Completer -> Completer
f OptionFields a
p = OptionFields a
p { optCompleter :: Completer
optCompleter = Completer -> Completer
f (forall a. OptionFields a -> Completer
optCompleter OptionFields a
p) }
instance HasCompleter ArgumentFields where
modCompleter :: forall a.
(Completer -> Completer) -> ArgumentFields a -> ArgumentFields a
modCompleter Completer -> Completer
f ArgumentFields a
p = ArgumentFields a
p { argCompleter :: Completer
argCompleter = Completer -> Completer
f (forall a. ArgumentFields a -> Completer
argCompleter ArgumentFields a
p) }
class HasValue f where
hasValueDummy :: f a -> ()
instance HasValue OptionFields where
hasValueDummy :: forall a. OptionFields a -> ()
hasValueDummy OptionFields a
_ = ()
instance HasValue ArgumentFields where
hasValueDummy :: forall a. ArgumentFields a -> ()
hasValueDummy ArgumentFields a
_ = ()
class HasMetavar f where
hasMetavarDummy :: f a -> ()
instance HasMetavar OptionFields where
hasMetavarDummy :: forall a. OptionFields a -> ()
hasMetavarDummy OptionFields a
_ = ()
instance HasMetavar ArgumentFields where
hasMetavarDummy :: forall a. ArgumentFields a -> ()
hasMetavarDummy ArgumentFields a
_ = ()
instance HasMetavar CommandFields where
hasMetavarDummy :: forall a. CommandFields a -> ()
hasMetavarDummy CommandFields a
_ = ()
data DefaultProp a = DefaultProp
(Maybe a)
(Maybe (a -> String))
instance Monoid (DefaultProp a) where
mempty :: DefaultProp a
mempty = forall a. Maybe a -> Maybe (a -> String) -> DefaultProp a
DefaultProp forall a. Maybe a
Nothing forall a. Maybe a
Nothing
mappend :: DefaultProp a -> DefaultProp a -> DefaultProp a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (DefaultProp a) where
(DefaultProp Maybe a
d1 Maybe (a -> String)
s1) <> :: DefaultProp a -> DefaultProp a -> DefaultProp a
<> (DefaultProp Maybe a
d2 Maybe (a -> String)
s2) =
forall a. Maybe a -> Maybe (a -> String) -> DefaultProp a
DefaultProp (Maybe a
d1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe a
d2) (Maybe (a -> String)
s1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (a -> String)
s2)
data Mod f a = Mod (f a -> f a)
(DefaultProp a)
(OptProperties -> OptProperties)
optionMod :: (OptProperties -> OptProperties) -> Mod f a
optionMod :: forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod forall a. a -> a
id forall a. Monoid a => a
mempty
fieldMod :: (f a -> f a) -> Mod f a
fieldMod :: forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod f a -> f a
f = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod f a -> f a
f forall a. Monoid a => a
mempty forall a. a -> a
id
instance Monoid (Mod f a) where
mempty :: Mod f a
mempty = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod forall a. a -> a
id forall a. Monoid a => a
mempty forall a. a -> a
id
mappend :: Mod f a -> Mod f a -> Mod f a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (Mod f a) where
Mod f a -> f a
f1 DefaultProp a
d1 OptProperties -> OptProperties
g1 <> :: Mod f a -> Mod f a -> Mod f a
<> Mod f a -> f a
f2 DefaultProp a
d2 OptProperties -> OptProperties
g2
= forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod (f a -> f a
f2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f a
f1) (DefaultProp a
d2 forall a. Semigroup a => a -> a -> a
<> DefaultProp a
d1) (OptProperties -> OptProperties
g2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptProperties -> OptProperties
g1)
baseProps :: OptProperties
baseProps :: OptProperties
baseProps = OptProperties
{ propMetaVar :: String
propMetaVar = String
""
, propVisibility :: OptVisibility
propVisibility = OptVisibility
Visible
, propHelp :: Chunk Doc
propHelp = forall a. Monoid a => a
mempty
, propShowDefault :: Maybe String
propShowDefault = forall a. Maybe a
Nothing
, propDescMod :: Maybe (Doc -> Doc)
propDescMod = forall a. Maybe a
Nothing
, propShowGlobal :: Bool
propShowGlobal = Bool
True
}
mkCommand :: Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])
mkCommand :: forall a.
Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])
mkCommand Mod CommandFields a
m = (Maybe String
group, [(String, ParserInfo a)]
cmds)
where
Mod CommandFields a -> CommandFields a
f DefaultProp a
_ OptProperties -> OptProperties
_ = Mod CommandFields a
m
CommandFields [(String, ParserInfo a)]
cmds Maybe String
group = CommandFields a -> CommandFields a
f (forall a.
[(String, ParserInfo a)] -> Maybe String -> CommandFields a
CommandFields [] forall a. Maybe a
Nothing)
mkParser :: DefaultProp a
-> (OptProperties -> OptProperties)
-> OptReader a
-> Parser a
mkParser :: forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser d :: DefaultProp a
d@(DefaultProp Maybe a
def Maybe (a -> String)
_) OptProperties -> OptProperties
g OptReader a
rdr =
let
o :: Parser a
o = forall a. Option a -> Parser a
liftOpt forall a b. (a -> b) -> a -> b
$ forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Option a
mkOption DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr
in
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
o (\a
a -> Parser a
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) Maybe a
def
mkOption :: DefaultProp a
-> (OptProperties -> OptProperties)
-> OptReader a
-> Option a
mkOption :: forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Option a
mkOption DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr = forall a. OptReader a -> OptProperties -> Option a
Option OptReader a
rdr (forall a.
DefaultProp a -> (OptProperties -> OptProperties) -> OptProperties
mkProps DefaultProp a
d OptProperties -> OptProperties
g)
mkProps :: DefaultProp a
-> (OptProperties -> OptProperties)
-> OptProperties
mkProps :: forall a.
DefaultProp a -> (OptProperties -> OptProperties) -> OptProperties
mkProps (DefaultProp Maybe a
def Maybe (a -> String)
sdef) OptProperties -> OptProperties
g = OptProperties
props
where
props :: OptProperties
props = (OptProperties -> OptProperties
g OptProperties
baseProps)
{ propShowDefault :: Maybe String
propShowDefault = Maybe (a -> String)
sdef forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
def }
internal :: Mod f a
internal :: forall (f :: * -> *) a. Mod f a
internal = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p -> OptProperties
p { propVisibility :: OptVisibility
propVisibility = OptVisibility
Internal }
noGlobal :: Mod f a
noGlobal :: forall (f :: * -> *) a. Mod f a
noGlobal = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
pp -> OptProperties
pp { propShowGlobal :: Bool
propShowGlobal = Bool
False }