{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}

-- | Common parsers for options
--
--    - 'option' specifies a named value on the command line
--    - 'flag' specifies a value derived from the presence of the flag
--    - 'named' specifies a value derived from the name of a flag
--    - 'switch' specifies a flag with a boolean value
--    - 'argument' specifies a value not delimited by an option name, the first string value is parsed
--    - 'positional' specifies an argument which is expected to be at a specific place in the list of arguments
module Data.Registry.Options.Parsers where

import Data.Dynamic
import Data.Either
import Data.Registry
import Data.Registry.Options.OptionDescription
import Data.Registry.Options.Decoder
import Data.Registry.Options.DefaultValues
import Data.Registry.Options.FieldConfiguration
import Data.Registry.Options.Help
import Data.Registry.Options.Lexemes
import Data.Registry.Options.Parser
import GHC.TypeLits
import Protolude

-- | Create an option:
--     - with a short/long name
--     - a metavar
--     - no active/default values
--
--   The OptionDescriptionUpdates list can be used to override values or provide a help
option :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
option :: OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
option OptionDescriptionUpdates
os = do
  let fieldType :: Text
fieldType = forall a. Typeable a => Text
showType @a
  (FieldConfiguration
 -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Typed
     (FieldConfiguration
      -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
forall a. Typeable a => a -> Typed a
fun (\FieldConfiguration
fieldOptions -> forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
FieldConfiguration
-> Positional
-> Text
-> OptionDescriptionUpdates
-> DefaultValue s a
-> ActiveValue s a
-> Decoder a
-> Parser s a
parseField @s @a FieldConfiguration
fieldOptions Positional
NonPositional Text
fieldType OptionDescriptionUpdates
os)
    Typed
  (FieldConfiguration
   -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Registry
     '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Registry
  '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
setNoDefaultValues @s @a

-- | Create a parser for a list of values
options :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
options :: OptionDescriptionUpdates
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s [a], Parser s a, DefaultValue s a, ActiveValue s a,
       OptionDescription]
options OptionDescriptionUpdates
os = (Parser s a -> Parser s [a]) -> Typed (Parser s a -> Parser s [a])
forall a. Typeable a => a -> Typed a
fun (forall (s :: Symbol) a. Parser s a -> Parser s [a]
listParser @s @a) Typed (Parser s a -> Parser s [a])
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s [a], Parser s a, DefaultValue s a, ActiveValue s a,
       OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
option @s @a OptionDescriptionUpdates
os

-- | Create a parser for an optional value
optionMaybe :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
optionMaybe :: OptionDescriptionUpdates
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s (Maybe a), Parser s a, DefaultValue s a,
       ActiveValue s a, OptionDescription]
optionMaybe OptionDescriptionUpdates
os = (Parser s a -> Parser s (Maybe a))
-> Typed (Parser s a -> Parser s (Maybe a))
forall a. Typeable a => a -> Typed a
fun (forall (s :: Symbol) a. Parser s a -> Parser s (Maybe a)
maybeParser @s @a) Typed (Parser s a -> Parser s (Maybe a))
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s (Maybe a), Parser s a, DefaultValue s a,
       ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
option @s @a OptionDescriptionUpdates
os

-- | Create a flag:
--     - with a short/long name
--     - a metavar
--     - an active value
--     - an optional default value
--
--   The OptionDescriptionUpdates list can be used to override values or provide a help
flag :: forall s a. (KnownSymbol s, Typeable a, Show a) => a -> Maybe a -> OptionDescriptionUpdates -> Registry _ _
flag :: a
-> Maybe a
-> OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a]
flag a
activeValue Maybe a
defaultValue OptionDescriptionUpdates
os = do
  let fieldType :: Text
fieldType = forall a. Typeable a => Text
showType @a
  (FieldConfiguration
 -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Typed
     (FieldConfiguration
      -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
forall a. Typeable a => a -> Typed a
fun (\FieldConfiguration
fieldOptions -> forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
FieldConfiguration
-> Positional
-> Text
-> OptionDescriptionUpdates
-> DefaultValue s a
-> ActiveValue s a
-> Decoder a
-> Parser s a
parseField @s @a FieldConfiguration
fieldOptions Positional
NonPositional Text
fieldType OptionDescriptionUpdates
os)
    Typed
  (FieldConfiguration
   -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Registry '[] '[DefaultValue s a, ActiveValue s a]
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ Typed (DefaultValue s a)
-> (a -> Typed (DefaultValue s a))
-> Maybe a
-> Typed (DefaultValue s a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Typed (DefaultValue s a)
forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Typed (DefaultValue s a)
noDefaultValue (forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (DefaultValue s a)
setDefaultValue @s @a) Maybe a
defaultValue
    Typed (DefaultValue s a)
-> Typed (ActiveValue s a)
-> Registry '[] '[DefaultValue s a, ActiveValue s a]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (ActiveValue s a)
setActiveValue @s @a a
activeValue

-- | Create a flag where the name of the flag can be decoded as a value:
--   The OptionDescriptionUpdates list can be used to override values or provide a help
named :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
named :: OptionDescriptionUpdates
-> Registry
     '[Decoder a, DefaultValue s a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
named OptionDescriptionUpdates
os = do
  let fieldType :: Text
fieldType = forall a. Typeable a => Text
showType @a
  let p :: Decoder a -> DefaultValue s a -> Parser s a
p = \(Decoder a
decoder :: Decoder a) (DefaultValue s a
defaultValue :: DefaultValue s a) -> forall (s :: Symbol) a.
Help -> (Lexemes -> Either Text (a, Lexemes)) -> Parser s a
Parser @s @a (OptionDescription -> Help
fromCliOption (OptionDescription -> Help) -> OptionDescription -> Help
forall a b. (a -> b) -> a -> b
$ OptionDescriptionUpdates -> OptionDescription
makeOptionDescription OptionDescriptionUpdates
os) ((Lexemes -> Either Text (a, Lexemes)) -> Parser s a)
-> (Lexemes -> Either Text (a, Lexemes)) -> Parser s a
forall a b. (a -> b) -> a -> b
$ \Lexemes
ls -> do
        case [Either Text (Text, a)] -> ([Text], [(Text, a)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text (Text, a)] -> ([Text], [(Text, a)]))
-> [Either Text (Text, a)] -> ([Text], [(Text, a)])
forall a b. (a -> b) -> a -> b
$ (\Text
n -> (Text
n,) (a -> (Text, a)) -> Either Text a -> Either Text (Text, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a -> Text -> Either Text a
forall a. Decoder a -> Text -> Either Text a
decode Decoder a
decoder Text
n) (Text -> Either Text (Text, a))
-> [Text] -> [Either Text (Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexemes -> [Text]
getFlagNames Lexemes
ls of
          ([Text]
_, (Text
f, a
a) : [(Text, a)]
_) -> (a, Lexemes) -> Either Text (a, Lexemes)
forall a b. b -> Either a b
Right (a
a, Text -> Lexemes -> Lexemes
popFlag Text
f Lexemes
ls)
          ([Text], [(Text, a)])
_ -> case DefaultValue s a -> Maybe a
forall a (s :: Symbol).
(Typeable a, KnownSymbol s) =>
DefaultValue s a -> Maybe a
getDefaultValue DefaultValue s a
defaultValue of
            Just a
def -> (a, Lexemes) -> Either Text (a, Lexemes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
def, Lexemes
ls)
            Maybe a
_ -> Text -> Either Text (a, Lexemes)
forall a b. a -> Either a b
Left (Text -> Either Text (a, Lexemes))
-> Text -> Either Text (a, Lexemes)
forall a b. (a -> b) -> a -> b
$ Text
"Flag not found for data type `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  (Decoder a -> DefaultValue s a -> Parser s a)
-> Typed (Decoder a -> DefaultValue s a -> Parser s a)
forall a. Typeable a => a -> Typed a
fun Decoder a -> DefaultValue s a -> Parser s a
p
    Typed (Decoder a -> DefaultValue s a -> Parser s a)
-> Registry
     '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[Decoder a, DefaultValue s a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Registry
  '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
setNoDefaultValues @s @a

-- | Create a switch:
--     - with a short/long name
--     - a metavar
--     - an active value: True
--     - an default value: False
--
--   The OptionDescriptionUpdates list can be used to override values or provide a help
switch :: forall s. (KnownSymbol s) => OptionDescriptionUpdates -> Registry _ _
switch :: OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s Bool, ActiveValue s Bool,
       Decoder Bool]
     '[Parser s Bool, DefaultValue s Bool, ActiveValue s Bool]
switch OptionDescriptionUpdates
os = do
  let fieldType :: Text
fieldType = forall a. Typeable a => Text
showType @Bool
  (FieldConfiguration
 -> DefaultValue s Bool
 -> ActiveValue s Bool
 -> Decoder Bool
 -> Parser s Bool)
-> Typed
     (FieldConfiguration
      -> DefaultValue s Bool
      -> ActiveValue s Bool
      -> Decoder Bool
      -> Parser s Bool)
forall a. Typeable a => a -> Typed a
fun (\FieldConfiguration
fieldOptions -> forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
FieldConfiguration
-> Positional
-> Text
-> OptionDescriptionUpdates
-> DefaultValue s a
-> ActiveValue s a
-> Decoder a
-> Parser s a
parseField @s @Bool FieldConfiguration
fieldOptions Positional
NonPositional Text
fieldType OptionDescriptionUpdates
os)
    Typed
  (FieldConfiguration
   -> DefaultValue s Bool
   -> ActiveValue s Bool
   -> Decoder Bool
   -> Parser s Bool)
-> Registry '[] '[DefaultValue s Bool, ActiveValue s Bool]
-> Registry
     '[FieldConfiguration, DefaultValue s Bool, ActiveValue s Bool,
       Decoder Bool]
     '[Parser s Bool, DefaultValue s Bool, ActiveValue s Bool]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (DefaultValue s a)
setDefaultValue @s Bool
False
    Typed (DefaultValue s Bool)
-> Typed (ActiveValue s Bool)
-> Registry '[] '[DefaultValue s Bool, ActiveValue s Bool]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (ActiveValue s a)
setActiveValue @s Bool
True

-- | Create an argument:
--     - with no short/long names
--     - a metavar
--     - no active/default values
--
--   The OptionDescriptionUpdates list can be used to override values or provide a help
--
--   When the argument is read, its value is removed from the list of lexed values
argument :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
argument :: OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
argument OptionDescriptionUpdates
os = do
  let fieldType :: Text
fieldType = forall a. Typeable a => Text
showType @a
  (FieldConfiguration
 -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Typed
     (FieldConfiguration
      -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
forall a. Typeable a => a -> Typed a
fun (\FieldConfiguration
fieldOptions -> forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
FieldConfiguration
-> Positional
-> Text
-> OptionDescriptionUpdates
-> DefaultValue s a
-> ActiveValue s a
-> Decoder a
-> Parser s a
parseField @s @a FieldConfiguration
fieldOptions Positional
Positional Text
fieldType OptionDescriptionUpdates
os)
    Typed
  (FieldConfiguration
   -> DefaultValue s a -> ActiveValue s a -> Decoder a -> Parser s a)
-> Registry
     '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Registry
  '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
setNoDefaultValues @s @a

-- | Create a parser for a list of arguments
arguments :: forall s a. (KnownSymbol s, Typeable a, Show a) => OptionDescriptionUpdates -> Registry _ _
arguments :: OptionDescriptionUpdates
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s [a], Parser s a, DefaultValue s a, ActiveValue s a,
       OptionDescription]
arguments OptionDescriptionUpdates
os = (Parser s a -> Parser s [a]) -> Typed (Parser s a -> Parser s [a])
forall a. Typeable a => a -> Typed a
fun (forall (s :: Symbol) a. Parser s a -> Parser s [a]
listParser @s @a) Typed (Parser s a -> Parser s [a])
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[Parser s a, FieldConfiguration, DefaultValue s a,
       ActiveValue s a, Decoder a]
     '[Parser s [a], Parser s a, DefaultValue s a, ActiveValue s a,
       OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a, Show a) =>
OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, DefaultValue s a, ActiveValue s a, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
argument @s @a OptionDescriptionUpdates
os

-- | Create a positional argument, to parse the nth value (starting from 0):
--     - with no short/long names
--     - a metavar
--     - no active/default values
--
--   The OptionDescriptionUpdates list can be used to override values or provide a help
--
--   When the argument is read, its value is left in the list of lexed values
positional :: forall s a. (KnownSymbol s, Typeable a, Show a) => Int -> OptionDescriptionUpdates -> Registry _ _
positional :: Int
-> OptionDescriptionUpdates
-> Registry
     '[FieldConfiguration, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
positional Int
n OptionDescriptionUpdates
os = do
  let p :: FieldConfiguration -> Decoder a -> Parser s a
p FieldConfiguration
fieldOptions = \Decoder a
d -> do
        let o :: OptionDescription
o = OptionDescriptionUpdates -> OptionDescription
makeOptionDescription (OptionDescriptionUpdates -> OptionDescription)
-> OptionDescriptionUpdates -> OptionDescription
forall a b. (a -> b) -> a -> b
$ Text -> OptionDescriptionUpdate
metavar (FieldConfiguration -> Text -> Text
makeMetavar FieldConfiguration
fieldOptions (forall a. Typeable a => Text
showType @a)) OptionDescriptionUpdate
-> OptionDescriptionUpdates -> OptionDescriptionUpdates
forall a. a -> [a] -> [a]
: OptionDescriptionUpdates
os
        forall (s :: Symbol) a.
Help -> (Lexemes -> Either Text (a, Lexemes)) -> Parser s a
Parser @s @a (OptionDescription -> Help
fromCliOption OptionDescription
o) ((Lexemes -> Either Text (a, Lexemes)) -> Parser s a)
-> (Lexemes -> Either Text (a, Lexemes)) -> Parser s a
forall a b. (a -> b) -> a -> b
$ \Lexemes
ls -> do
          -- take element at position n and make sure to keep all the other
          -- arguments intact because we need their position to parse them
          case [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay ([Text] -> Maybe Text)
-> ([Text] -> [Text]) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
n ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Lexemes -> [Text]
getArguments Lexemes
ls of
            Maybe Text
Nothing -> Text -> Either Text (a, Lexemes)
forall a b. a -> Either a b
Left (Text -> Either Text (a, Lexemes))
-> Text -> Either Text (a, Lexemes)
forall a b. (a -> b) -> a -> b
$ Text
"No argument to parse at position " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
n
            Just Text
arg ->
              case Decoder a -> Text -> Either Text a
forall a. Decoder a -> Text -> Either Text a
decode Decoder a
d Text
arg of
                Left Text
e -> Text -> Either Text (a, Lexemes)
forall a b. a -> Either a b
Left Text
e
                Right a
v -> (a, Lexemes) -> Either Text (a, Lexemes)
forall a b. b -> Either a b
Right (a
v, Lexemes
ls)

  (FieldConfiguration -> Decoder a -> Parser s a)
-> Typed (FieldConfiguration -> Decoder a -> Parser s a)
forall a. Typeable a => a -> Typed a
fun FieldConfiguration -> Decoder a -> Parser s a
p
    Typed (FieldConfiguration -> Decoder a -> Parser s a)
-> Registry
     '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
-> Registry
     '[FieldConfiguration, Decoder a]
     '[Parser s a, DefaultValue s a, ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Registry
  '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
setNoDefaultValues @s @a

-- | Set an active value for a given field name and field type
setActiveValue :: forall s a. (KnownSymbol s, Typeable a) => a -> Typed (ActiveValue s a)
setActiveValue :: forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (ActiveValue s a)
setActiveValue = ActiveValue s a -> Typed (ActiveValue s a)
forall a. Typeable a => a -> Typed a
fun (ActiveValue s a -> Typed (ActiveValue s a))
-> (a -> ActiveValue s a) -> a -> Typed (ActiveValue s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a.
(Typeable a, KnownSymbol s) =>
a -> ActiveValue s a
createActiveValue @s @a

-- | Set a default value for a given field name and field type
setDefaultValue :: forall s a. (KnownSymbol s, Typeable a) => a -> Typed (DefaultValue s a)
setDefaultValue :: forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (DefaultValue s a)
setDefaultValue = DefaultValue s a -> Typed (DefaultValue s a)
forall a. Typeable a => a -> Typed a
fun (DefaultValue s a -> Typed (DefaultValue s a))
-> (a -> DefaultValue s a) -> a -> Typed (DefaultValue s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a.
(Typeable a, KnownSymbol s) =>
a -> DefaultValue s a
createDefaultValue @s @a

-- | Allow to specify that a given field name and type has some default/active values
setDefaultValues :: forall s a. (KnownSymbol s, Typeable a) => Maybe a -> Maybe a -> Registry _ _
setDefaultValues :: Maybe a
-> Maybe a -> Registry '[] '[DefaultValue s a, ActiveValue s a]
setDefaultValues Maybe a
defaultValue Maybe a
activeValue =
  Typed (DefaultValue s a)
-> (a -> Typed (DefaultValue s a))
-> Maybe a
-> Typed (DefaultValue s a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Typed (DefaultValue s a)
noDefaultValue @s) (forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (DefaultValue s a)
setDefaultValue @s) Maybe a
defaultValue
    Typed (DefaultValue s a)
-> Typed (ActiveValue s a)
-> Registry '[] '[DefaultValue s a, ActiveValue s a]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ Typed (ActiveValue s a)
-> (a -> Typed (ActiveValue s a))
-> Maybe a
-> Typed (ActiveValue s a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Typed (ActiveValue s a)
noActiveValue @s) (forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
a -> Typed (ActiveValue s a)
setActiveValue @s) Maybe a
activeValue

-- | Allow to specify that a given field name and type has no default/active values
setNoDefaultValues :: forall s a. (KnownSymbol s, Typeable a) => Registry _ _
setNoDefaultValues :: Registry
  '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
setNoDefaultValues =
  forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Typed (DefaultValue s a)
noDefaultValue @s @a
    Typed (DefaultValue s a)
-> Registry '[] '[ActiveValue s a, OptionDescription]
-> Registry
     '[] '[DefaultValue s a, ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ forall (s :: Symbol) a.
(KnownSymbol s, Typeable a) =>
Typed (ActiveValue s a)
noActiveValue @s @a
    Typed (ActiveValue s a)
-> Typed OptionDescription
-> Registry '[] '[ActiveValue s a, OptionDescription]
forall a b c. AddRegistryUncheckedLike a b c => a -> b -> c
<+ OptionDescription -> Typed OptionDescription
forall a. (Typeable a, Show a) => a -> Typed a
val (OptionDescription
forall a. Monoid a => a
mempty :: OptionDescription)

-- * Template Haskell

-- | This function is used by the TH module to parse a command name at the beginning
--   of a list of arguments
commandNameParser :: Text -> Parser Command ()
commandNameParser :: Text -> Parser Command ()
commandNameParser Text
cn = Help -> (Lexemes -> Either Text ((), Lexemes)) -> Parser Command ()
forall (s :: Symbol) a.
Help -> (Lexemes -> Either Text (a, Lexemes)) -> Parser s a
Parser Help
noHelp ((Lexemes -> Either Text ((), Lexemes)) -> Parser Command ())
-> (Lexemes -> Either Text ((), Lexemes)) -> Parser Command ()
forall a b. (a -> b) -> a -> b
$ \Lexemes
ls ->
  case Lexemes -> [Text]
lexedArguments Lexemes
ls of
    [] -> Text -> Either Text ((), Lexemes)
forall a b. a -> Either a b
Left (Text -> Either Text ((), Lexemes))
-> Text -> Either Text ((), Lexemes)
forall a b. (a -> b) -> a -> b
$ Text
"no arguments found, expected command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn
    Text
n : [Text]
_ ->
      if Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cn
        then ((), Lexemes) -> Either Text ((), Lexemes)
forall a b. b -> Either a b
Right ((), Lexemes -> Lexemes
popArgumentValue Lexemes
ls)
        else Text -> Either Text ((), Lexemes)
forall a b. a -> Either a b
Left (Text -> Either Text ((), Lexemes))
-> Text -> Either Text ((), Lexemes)
forall a b. (a -> b) -> a -> b
$ Text
"expected command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n