module System.Console.CmdArgs.Explicit.Type where

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Semigroup hiding (Arg)
import Prelude


-- | A name, either the name of a flag (@--/foo/@) or the name of a mode.
type Name = String

-- | A help message that goes with either a flag or a mode.
type Help = String

-- | The type of a flag, i.e. @--foo=/TYPE/@.
type FlagHelp = String


---------------------------------------------------------------------
-- UTILITY

-- | Parse a boolean, accepts as True: true yes on enabled 1.
parseBool :: String -> Maybe Bool
parseBool :: [Char] -> Maybe Bool
parseBool [Char]
s | [Char]
ls forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
true  = forall a. a -> Maybe a
Just Bool
True
            | [Char]
ls forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
false = forall a. a -> Maybe a
Just Bool
False
            | Bool
otherwise = forall a. Maybe a
Nothing
    where
        ls :: [Char]
ls = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s
        true :: [[Char]]
true = [[Char]
"true",[Char]
"yes",[Char]
"on",[Char]
"enabled",[Char]
"1"]
        false :: [[Char]]
false = [[Char]
"false",[Char]
"no",[Char]
"off",[Char]
"disabled",[Char]
"0"]


---------------------------------------------------------------------
-- GROUPS

-- | A group of items (modes or flags). The items are treated as a list, but the
--   group structure is used when displaying the help message.
data Group a = Group
    {forall a. Group a -> [a]
groupUnnamed :: [a] -- ^ Normal items.
    ,forall a. Group a -> [a]
groupHidden :: [a] -- ^ Items that are hidden (not displayed in the help message).
    ,forall a. Group a -> [([Char], [a])]
groupNamed :: [(Help, [a])] -- ^ Items that have been grouped, along with a description of each group.
    } deriving Int -> Group a -> ShowS
forall a. Show a => Int -> Group a -> ShowS
forall a. Show a => [Group a] -> ShowS
forall a. Show a => Group a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Group a] -> ShowS
$cshowList :: forall a. Show a => [Group a] -> ShowS
show :: Group a -> [Char]
$cshow :: forall a. Show a => Group a -> [Char]
showsPrec :: Int -> Group a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Group a -> ShowS
Show

instance Functor Group where
    fmap :: forall a b. (a -> b) -> Group a -> Group b
fmap a -> b
f (Group [a]
a [a]
b [([Char], [a])]
c) = forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group (forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
a) (forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
b) (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [([Char], [a])]
c)

instance Semigroup (Group a) where
    Group [a]
x1 [a]
x2 [([Char], [a])]
x3 <> :: Group a -> Group a -> Group a
<> Group [a]
y1 [a]
y2 [([Char], [a])]
y3 = forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group ([a]
x1forall a. [a] -> [a] -> [a]
++[a]
y1) ([a]
x2forall a. [a] -> [a] -> [a]
++[a]
y2) ([([Char], [a])]
x3forall a. [a] -> [a] -> [a]
++[([Char], [a])]
y3)

instance Monoid (Group a) where
    mempty :: Group a
mempty = forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group [] [] []
    mappend :: Group a -> Group a -> Group a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Convert a group into a list.
fromGroup :: Group a -> [a]
fromGroup :: forall a. Group a -> [a]
fromGroup (Group [a]
x [a]
y [([Char], [a])]
z) = [a]
x forall a. [a] -> [a] -> [a]
++ [a]
y forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([Char], [a])]
z

-- | Convert a list into a group, placing all fields in 'groupUnnamed'.
toGroup :: [a] -> Group a
toGroup :: forall a. [a] -> Group a
toGroup [a]
x = forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group [a]
x [] []


---------------------------------------------------------------------
-- TYPES

-- | A mode. Do not use the 'Mode' constructor directly, instead
--   use 'mode' to construct the 'Mode' and then record updates.
--   Each mode has three main features:
--
--   * A list of submodes ('modeGroupModes')
--
--   * A list of flags ('modeGroupFlags')
--
--   * Optionally an unnamed argument ('modeArgs')
--
--  To produce the help information for a mode, either use 'helpText' or 'show'.
data Mode a = Mode
    {forall a. Mode a -> Group (Mode a)
modeGroupModes :: Group (Mode a) -- ^ The available sub-modes
    ,forall a. Mode a -> [[Char]]
modeNames :: [Name] -- ^ The names assigned to this mode (for the root mode, this name is used as the program name)
    ,forall a. Mode a -> a
modeValue :: a -- ^ Value to start with
    ,forall a. Mode a -> a -> Either [Char] a
modeCheck :: a -> Either String a -- ^ Check the value reprsented by a mode is correct, after applying all flags
    ,forall a. Mode a -> a -> Maybe [[Char]]
modeReform :: a -> Maybe [String] -- ^ Given a value, try to generate the input arguments.
    ,forall a. Mode a -> Bool
modeExpandAt :: Bool -- ^ Expand @\@@ arguments with 'expandArgsAt', defaults to 'True', only applied if using an 'IO' processing function.
                          --   Only the root 'Mode's value will be used.
    ,forall a. Mode a -> [Char]
modeHelp :: Help -- ^ Help text
    ,forall a. Mode a -> [[Char]]
modeHelpSuffix :: [String] -- ^ A longer help suffix displayed after a mode
    ,forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs :: ([Arg a], Maybe (Arg a)) -- ^ The unnamed arguments, a series of arguments, followed optionally by one for all remaining slots
    ,forall a. Mode a -> Group (Flag a)
modeGroupFlags :: Group (Flag a) -- ^ Groups of flags
    }

-- | Extract the modes from a 'Mode'
modeModes :: Mode a -> [Mode a]
modeModes :: forall a. Mode a -> [Mode a]
modeModes = forall a. Group a -> [a]
fromGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Mode a -> Group (Mode a)
modeGroupModes

-- | Extract the flags from a 'Mode'
modeFlags :: Mode a -> [Flag a]
modeFlags :: forall a. Mode a -> [Flag a]
modeFlags = forall a. Group a -> [a]
fromGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Mode a -> Group (Flag a)
modeGroupFlags

-- | The 'FlagInfo' type has the following meaning:
--
--
-- >              FlagReq     FlagOpt      FlagOptRare/FlagNone
-- > -xfoo        -x=foo      -x=foo       -x -foo
-- > -x foo       -x=foo      -x foo       -x foo
-- > -x=foo       -x=foo      -x=foo       -x=foo
-- > --xx foo     --xx=foo    --xx foo     --xx foo
-- > --xx=foo     --xx=foo    --xx=foo     --xx=foo
data FlagInfo
    = FlagReq             -- ^ Required argument
    | FlagOpt String      -- ^ Optional argument
    | FlagOptRare String  -- ^ Optional argument that requires an = before the value
    | FlagNone            -- ^ No argument
      deriving (FlagInfo -> FlagInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagInfo -> FlagInfo -> Bool
$c/= :: FlagInfo -> FlagInfo -> Bool
== :: FlagInfo -> FlagInfo -> Bool
$c== :: FlagInfo -> FlagInfo -> Bool
Eq,Eq FlagInfo
FlagInfo -> FlagInfo -> Bool
FlagInfo -> FlagInfo -> Ordering
FlagInfo -> FlagInfo -> FlagInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FlagInfo -> FlagInfo -> FlagInfo
$cmin :: FlagInfo -> FlagInfo -> FlagInfo
max :: FlagInfo -> FlagInfo -> FlagInfo
$cmax :: FlagInfo -> FlagInfo -> FlagInfo
>= :: FlagInfo -> FlagInfo -> Bool
$c>= :: FlagInfo -> FlagInfo -> Bool
> :: FlagInfo -> FlagInfo -> Bool
$c> :: FlagInfo -> FlagInfo -> Bool
<= :: FlagInfo -> FlagInfo -> Bool
$c<= :: FlagInfo -> FlagInfo -> Bool
< :: FlagInfo -> FlagInfo -> Bool
$c< :: FlagInfo -> FlagInfo -> Bool
compare :: FlagInfo -> FlagInfo -> Ordering
$ccompare :: FlagInfo -> FlagInfo -> Ordering
Ord,Int -> FlagInfo -> ShowS
[FlagInfo] -> ShowS
FlagInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FlagInfo] -> ShowS
$cshowList :: [FlagInfo] -> ShowS
show :: FlagInfo -> [Char]
$cshow :: FlagInfo -> [Char]
showsPrec :: Int -> FlagInfo -> ShowS
$cshowsPrec :: Int -> FlagInfo -> ShowS
Show)

-- | Extract the value from inside a 'FlagOpt' or 'FlagOptRare', or raises an error.
fromFlagOpt :: FlagInfo -> String
fromFlagOpt :: FlagInfo -> [Char]
fromFlagOpt (FlagOpt [Char]
x) = [Char]
x
fromFlagOpt (FlagOptRare [Char]
x) = [Char]
x

-- | A function to take a string, and a value, and either produce an error message
--   (@Left@), or a modified value (@Right@).
type Update a = String -> a -> Either String a

-- | A flag, consisting of a list of flag names and other information.
data Flag a = Flag
    {forall a. Flag a -> [[Char]]
flagNames :: [Name] -- ^ The names for the flag.
    ,forall a. Flag a -> FlagInfo
flagInfo :: FlagInfo -- ^ Information about a flag's arguments.
    ,forall a. Flag a -> Update a
flagValue :: Update a -- ^ The way of processing a flag.
    ,forall a. Flag a -> [Char]
flagType :: FlagHelp -- ^ The type of data for the flag argument, i.e. FILE\/DIR\/EXT
    ,forall a. Flag a -> [Char]
flagHelp :: Help -- ^ The help message associated with this flag.
    }


-- | An unnamed argument. Anything not starting with @-@ is considered an argument,
--   apart from @\"-\"@ which is considered to be the argument @\"-\"@, and any arguments
--   following @\"--\"@. For example:
--
-- > programname arg1 -j - --foo arg3 -- -arg4 --arg5=1 arg6
--
--   Would have the arguments:
--
-- > ["arg1","-","arg3","-arg4","--arg5=1","arg6"]
data Arg a = Arg
    {forall a. Arg a -> Update a
argValue :: Update a -- ^ A way of processing the argument.
    ,forall a. Arg a -> [Char]
argType :: FlagHelp -- ^ The type of data for the argument, i.e. FILE\/DIR\/EXT
    ,forall a. Arg a -> Bool
argRequire :: Bool -- ^ Is at least one of these arguments required, the command line will fail if none are set
    }


---------------------------------------------------------------------
-- CHECK FLAGS

-- | Check that a mode is well formed.
checkMode :: Mode a -> Maybe String
checkMode :: forall a. Mode a -> Maybe [Char]
checkMode Mode a
x = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [[Char] -> [[Char]] -> Maybe [Char]
checkNames [Char]
"modes" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Mode a -> [[Char]]
modeNames forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Mode a]
modeModes Mode a
x
    ,forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Mode a -> Maybe [Char]
checkMode forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Mode a]
modeModes Mode a
x
    ,forall a. Group a -> Maybe [Char]
checkGroup forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
x
    ,forall a. Group a -> Maybe [Char]
checkGroup forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
x
    ,[Char] -> [[Char]] -> Maybe [Char]
checkNames [Char]
"flag names" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Flag a -> [[Char]]
flagNames forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Flag a]
modeFlags Mode a
x]
    where
        checkGroup :: Group a -> Maybe String
        checkGroup :: forall a. Group a -> Maybe [Char]
checkGroup Group a
x = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
            [[Char] -> Bool -> Maybe [Char]
check [Char]
"Empty group name" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. Group a -> [([Char], [a])]
groupNamed Group a
x
            ,[Char] -> Bool -> Maybe [Char]
check [Char]
"Empty group contents" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. Group a -> [([Char], [a])]
groupNamed Group a
x]

        checkNames :: String -> [Name] -> Maybe String
        checkNames :: [Char] -> [[Char]] -> Maybe [Char]
checkNames [Char]
msg [[Char]]
xs = [Char] -> Bool -> Maybe [Char]
check [Char]
"Empty names" (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs)) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` do
            [Char]
bad <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ [[Char]]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Eq a => [a] -> [a]
nub [[Char]]
xs
            let dupe :: [[Char]]
dupe = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== [Char]
bad) [[Char]]
xs
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
"Sanity check failed, multiple " forall a. [a] -> [a] -> [a]
++ [Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [[Char]]
dupe)

        check :: String -> Bool -> Maybe String
        check :: [Char] -> Bool -> Maybe [Char]
check [Char]
msg Bool
True = forall a. Maybe a
Nothing
        check [Char]
msg Bool
False = forall a. a -> Maybe a
Just [Char]
msg


---------------------------------------------------------------------
-- REMAP

-- | Like functor, but where the the argument isn't just covariant.
class Remap m where
    -- | Convert between two values.
    remap :: (a -> b) -- ^ Embed a value
          -> (b -> (a, a -> b)) -- ^ Extract the mode and give a way of re-embedding
          -> m a -> m b

-- | Restricted version of 'remap' where the values are isomorphic.
remap2 :: Remap m => (a -> b) -> (b -> a) -> m a -> m b
remap2 :: forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> a) -> m a -> m b
remap2 a -> b
f b -> a
g = forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap a -> b
f (\b
x -> (b -> a
g b
x, a -> b
f))

instance Remap Mode where
    remap :: forall a b. (a -> b) -> (b -> (a, a -> b)) -> Mode a -> Mode b
remap a -> b
f b -> (a, a -> b)
g Mode a
x = Mode a
x
        {modeGroupModes :: Group (Mode b)
modeGroupModes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap a -> b
f b -> (a, a -> b)
g) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
x
        ,modeValue :: b
modeValue = a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> a
modeValue Mode a
x
        ,modeCheck :: b -> Either [Char] b
modeCheck = \b
v -> let (a
a,a -> b
b) = b -> (a, a -> b)
g b
v in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
b forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> a -> Either [Char] a
modeCheck Mode a
x a
a
        ,modeReform :: b -> Maybe [[Char]]
modeReform = forall a. Mode a -> a -> Maybe [[Char]]
modeReform Mode a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> (a, a -> b)
g
        ,modeArgs :: ([Arg b], Maybe (Arg b))
modeArgs = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap a -> b
f b -> (a, a -> b)
g) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap a -> b
f b -> (a, a -> b)
g)) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
x
        ,modeGroupFlags :: Group (Flag b)
modeGroupFlags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap a -> b
f b -> (a, a -> b)
g) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
x}

instance Remap Flag where
    remap :: forall a b. (a -> b) -> (b -> (a, a -> b)) -> Flag a -> Flag b
remap a -> b
f b -> (a, a -> b)
g Flag a
x = Flag a
x{flagValue :: Update b
flagValue = forall a b. (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b
remapUpdate a -> b
f b -> (a, a -> b)
g forall a b. (a -> b) -> a -> b
$ forall a. Flag a -> Update a
flagValue Flag a
x}

instance Remap Arg where
    remap :: forall a b. (a -> b) -> (b -> (a, a -> b)) -> Arg a -> Arg b
remap a -> b
f b -> (a, a -> b)
g Arg a
x = Arg a
x{argValue :: Update b
argValue = forall a b. (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b
remapUpdate a -> b
f b -> (a, a -> b)
g forall a b. (a -> b) -> a -> b
$ forall a. Arg a -> Update a
argValue Arg a
x}

-- | Version of 'remap' for the 'Update' type alias.
remapUpdate :: (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b
remapUpdate :: forall a b. (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b
remapUpdate a -> b
f b -> (a, a -> b)
g Update a
upd = \[Char]
s b
v -> let (a
a,a -> b
b) = b -> (a, a -> b)
g b
v in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
b forall a b. (a -> b) -> a -> b
$ Update a
upd [Char]
s a
a


---------------------------------------------------------------------
-- MODE/MODES CREATORS

-- | Create an empty mode specifying only 'modeValue'. All other fields will usually be populated
--   using record updates.
modeEmpty :: a -> Mode a
modeEmpty :: forall a. a -> Mode a
modeEmpty a
x = forall a.
Group (Mode a)
-> [[Char]]
-> a
-> (a -> Either [Char] a)
-> (a -> Maybe [[Char]])
-> Bool
-> [Char]
-> [[Char]]
-> ([Arg a], Maybe (Arg a))
-> Group (Flag a)
-> Mode a
Mode forall a. Monoid a => a
mempty [] a
x forall a b. b -> Either a b
Right (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Bool
True [Char]
"" [] ([],forall a. Maybe a
Nothing) forall a. Monoid a => a
mempty

-- | Create a mode with a name, an initial value, some help text, a way of processing arguments
--   and a list of flags.
mode :: Name -> a -> Help -> Arg a -> [Flag a] -> Mode a
mode :: forall a. [Char] -> a -> [Char] -> Arg a -> [Flag a] -> Mode a
mode [Char]
name a
value [Char]
help Arg a
arg [Flag a]
flags = (forall a. a -> Mode a
modeEmpty a
value){modeNames :: [[Char]]
modeNames=[[Char]
name], modeHelp :: [Char]
modeHelp=[Char]
help, modeArgs :: ([Arg a], Maybe (Arg a))
modeArgs=([],forall a. a -> Maybe a
Just Arg a
arg), modeGroupFlags :: Group (Flag a)
modeGroupFlags=forall a. [a] -> Group a
toGroup [Flag a]
flags}

-- | Create a list of modes, with a program name, an initial value, some help text and the child modes.
modes :: String -> a -> Help -> [Mode a] -> Mode a
modes :: forall a. [Char] -> a -> [Char] -> [Mode a] -> Mode a
modes [Char]
name a
value [Char]
help [Mode a]
xs = (forall a. a -> Mode a
modeEmpty a
value){modeNames :: [[Char]]
modeNames=[[Char]
name], modeHelp :: [Char]
modeHelp=[Char]
help, modeGroupModes :: Group (Mode a)
modeGroupModes=forall a. [a] -> Group a
toGroup [Mode a]
xs}


---------------------------------------------------------------------
-- FLAG CREATORS

-- | Create a flag taking no argument value, with a list of flag names, an update function
--   and some help text.
flagNone :: [Name] -> (a -> a) -> Help -> Flag a
flagNone :: forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]]
names a -> a
f [Char]
help = forall a.
[[Char]] -> FlagInfo -> Update a -> [Char] -> [Char] -> Flag a
Flag [[Char]]
names FlagInfo
FlagNone forall {p} {a}. p -> a -> Either a a
upd [Char]
"" [Char]
help
    where upd :: p -> a -> Either a a
upd p
_ a
x = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ a -> a
f a
x

-- | Create a flag taking an optional argument value, with an optional value, a list of flag names,
--   an update function, the type of the argument and some help text.
flagOpt :: String -> [Name] -> Update a -> FlagHelp -> Help -> Flag a
flagOpt :: forall a.
[Char] -> [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagOpt [Char]
def [[Char]]
names Update a
upd [Char]
typ [Char]
help = forall a.
[[Char]] -> FlagInfo -> Update a -> [Char] -> [Char] -> Flag a
Flag [[Char]]
names ([Char] -> FlagInfo
FlagOpt [Char]
def) Update a
upd [Char]
typ [Char]
help

-- | Create a flag taking a required argument value, with a list of flag names,
--   an update function, the type of the argument and some help text.
flagReq :: [Name] -> Update a -> FlagHelp -> Help -> Flag a
flagReq :: forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]]
names Update a
upd [Char]
typ [Char]
help = forall a.
[[Char]] -> FlagInfo -> Update a -> [Char] -> [Char] -> Flag a
Flag [[Char]]
names FlagInfo
FlagReq Update a
upd [Char]
typ [Char]
help

-- | Create an argument flag, with an update function and the type of the argument.
flagArg :: Update a -> FlagHelp -> Arg a
flagArg :: forall a. Update a -> [Char] -> Arg a
flagArg Update a
upd [Char]
typ = forall a. Update a -> [Char] -> Bool -> Arg a
Arg Update a
upd [Char]
typ Bool
False

-- | Create a boolean flag, with a list of flag names, an update function and some help text.
flagBool :: [Name] -> (Bool -> a -> a) -> Help -> Flag a
flagBool :: forall a. [[Char]] -> (Bool -> a -> a) -> [Char] -> Flag a
flagBool [[Char]]
names Bool -> a -> a
f [Char]
help = forall a.
[[Char]] -> FlagInfo -> Update a -> [Char] -> [Char] -> Flag a
Flag [[Char]]
names ([Char] -> FlagInfo
FlagOptRare [Char]
"") [Char] -> a -> Either [Char] a
upd [Char]
"" [Char]
help
    where
        upd :: [Char] -> a -> Either [Char] a
upd [Char]
s a
x = case if [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"" then forall a. a -> Maybe a
Just Bool
True else [Char] -> Maybe Bool
parseBool [Char]
s of
            Just Bool
b -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> a -> a
f Bool
b a
x
            Maybe Bool
Nothing -> forall a b. a -> Either a b
Left [Char]
"expected boolean value (true/false)"