module Options.Applicative.Builder.Internal (
  -- * Internals
  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
  -- this is just so that it is not necessary to specify the kind of f
  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
_ = ()

-- mod --

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)

-- | An option modifier.
--
-- Option modifiers are values that represent a modification of the properties
-- of an option.
--
-- The type parameter @a@ is the return type of the option, while @f@ is a
-- record containing its properties (e.g. 'OptionFields' for regular options,
-- 'FlagFields' for flags, etc...).
--
-- An option modifier consists of 3 elements:
--
--  - A field modifier, of the form @f a -> f a@. These are essentially
--  (compositions of) setters for some of the properties supported by @f@.
--
--  - An optional default value and function to display it.
--
--  - A property modifier, of the form @OptProperties -> OptProperties@. This
--  is just like the field modifier, but for properties applicable to any
--  option.
--
-- Modifiers are instances of 'Monoid', and can be composed as such.
--
-- One rarely needs to deal with modifiers directly, as most of the times it is
-- sufficient to pass them to builders (such as 'strOption' or 'flag') to
-- create options (see 'Options.Applicative.Builder').
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
(<>)

-- | @since 0.13.0.0
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)

-- | Base default properties.
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], String -> Maybe (ParserInfo a))
mkCommand :: forall a.
Mod CommandFields a
-> (Maybe String, [String], String -> Maybe (ParserInfo a))
mkCommand Mod CommandFields a
m = (Maybe String
group, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, ParserInfo a)]
cmds, (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(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 }

-- | Hide this option completely from the help text
--
-- Use 'hidden' if the option should remain visible in the full description.
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 }


-- | Suppress this option from appearing in global options
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 }