{-# LANGUAGE PatternGuards, RecordWildCards #-}

module System.Console.CmdArgs.Implicit.Global(global) where

import System.Console.CmdArgs.Implicit.Local
import System.Console.CmdArgs.Implicit.Reform
import System.Console.CmdArgs.Implicit.Type
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import System.Console.CmdArgs.Default

import Control.Arrow
import Control.Monad
import Data.Char
import Data.Function
import Data.Generics.Any
import Data.List
import Data.Maybe


global :: Prog_ -> Mode (CmdArgs Any)
global :: Prog_ -> Mode (CmdArgs Any)
global Prog_
x = (CmdArgs Any -> Maybe [String])
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a. (a -> Maybe [String]) -> Mode a -> Mode a
setReform (Prog_ -> CmdArgs Any -> Maybe [String]
reform Prog_
y) (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
setHelp Prog_
y (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
x (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ Prog_ -> Mode (CmdArgs Any)
collapse (Prog_ -> Mode (CmdArgs Any)) -> Prog_ -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ Prog_ -> Prog_
assignGroups Prog_
y
    where y :: Prog_
y = Prog_ -> Prog_
assignNames (Prog_ -> Prog_) -> Prog_ -> Prog_
forall a b. (a -> b) -> a -> b
$ Prog_ -> Prog_
extraFlags Prog_
x


setProgOpts :: Prog_ -> Mode a -> Mode a
setProgOpts :: Prog_ -> Mode a -> Mode a
setProgOpts Prog_
p Mode a
m = Mode a
m{modeExpandAt :: Bool
modeExpandAt = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Prog_ -> Bool
progNoAtExpand Prog_
p
                   ,modeGroupModes :: Group (Mode a)
modeGroupModes = (Mode a -> Mode a) -> Group (Mode a) -> Group (Mode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Prog_ -> Mode a -> Mode a
forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
p) (Group (Mode a) -> Group (Mode a))
-> Group (Mode a) -> Group (Mode a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m}


---------------------------------------------------------------------
-- COLLAPSE THE FLAGS/MODES UPWARDS

collapse :: Prog_ -> Mode (CmdArgs Any)
collapse :: Prog_ -> Mode (CmdArgs Any)
collapse Prog_
x | [(Mode_, Mode (CmdArgs Any))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Mode_, Mode (CmdArgs Any))]
ms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ((Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any)
forall a b. (a, b) -> b
snd ((Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any))
-> (Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ [(Mode_, Mode (CmdArgs Any))] -> (Mode_, Mode (CmdArgs Any))
forall a. [a] -> a
head [(Mode_, Mode (CmdArgs Any))]
ms){modeNames :: [String]
modeNames=[Prog_ -> String
progProgram Prog_
x]}
           | [Mode (CmdArgs Any)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mode (CmdArgs Any)]
auto Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = String -> String -> Mode (CmdArgs Any)
forall a. String -> String -> a
err String
"prog" String
"Multiple automatic modes"
           | Bool
otherwise = ([Mode (CmdArgs Any)] -> Mode (CmdArgs Any)
forall a. [a] -> a
head ([Mode (CmdArgs Any)] -> Mode (CmdArgs Any))
-> [Mode (CmdArgs Any)] -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> [Mode (CmdArgs Any)] -> [Mode (CmdArgs Any)]
forall a b. (a -> b) -> [a] -> [b]
map Mode (CmdArgs Any) -> Mode (CmdArgs Any)
zeroMode [Mode (CmdArgs Any)]
auto [Mode (CmdArgs Any)]
-> [Mode (CmdArgs Any)] -> [Mode (CmdArgs Any)]
forall a. [a] -> [a] -> [a]
++ ((Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any))
-> [(Mode_, Mode (CmdArgs Any))] -> [Mode (CmdArgs Any)]
forall a b. (a -> b) -> [a] -> [b]
map (Mode (CmdArgs Any) -> Mode (CmdArgs Any)
emptyMode (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> ((Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any))
-> (Mode_, Mode (CmdArgs Any))
-> Mode (CmdArgs Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mode_, Mode (CmdArgs Any)) -> Mode (CmdArgs Any)
forall a b. (a, b) -> b
snd) [(Mode_, Mode (CmdArgs Any))]
ms)
                {modeNames :: [String]
modeNames=[Prog_ -> String
progProgram Prog_
x], modeGroupModes :: Group (Mode (CmdArgs Any))
modeGroupModes=Group (Mode (CmdArgs Any))
grouped, modeHelp :: String
modeHelp=Prog_ -> String
progHelp Prog_
x}
    where
        grouped :: Group (Mode (CmdArgs Any))
grouped = [Mode (CmdArgs Any)]
-> [Mode (CmdArgs Any)]
-> [(String, [Mode (CmdArgs Any)])]
-> Group (Mode (CmdArgs Any))
forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group (Maybe String -> [Mode (CmdArgs Any)]
pick Maybe String
forall a. Maybe a
Nothing) [] [(String
g, Maybe String -> [Mode (CmdArgs Any)]
pick (Maybe String -> [Mode (CmdArgs Any)])
-> Maybe String -> [Mode (CmdArgs Any)]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
g) | String
g <- [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Mode_, Mode (CmdArgs Any)) -> Maybe String)
-> [(Mode_, Mode (CmdArgs Any))] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Mode_ -> Maybe String
modeGroup (Mode_ -> Maybe String)
-> ((Mode_, Mode (CmdArgs Any)) -> Mode_)
-> (Mode_, Mode (CmdArgs Any))
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mode_, Mode (CmdArgs Any)) -> Mode_
forall a b. (a, b) -> a
fst) [(Mode_, Mode (CmdArgs Any))]
ms]
        pick :: Maybe String -> [Mode (CmdArgs Any)]
pick Maybe String
x = [Mode (CmdArgs Any)
m | (Mode_
m_,Mode (CmdArgs Any)
m) <- [(Mode_, Mode (CmdArgs Any))]
ms, Mode_ -> Maybe String
modeGroup Mode_
m_ Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
x]

        ms :: [(Mode_, Mode (CmdArgs Any))]
ms = (Mode_ -> (Mode_, Mode (CmdArgs Any)))
-> [Mode_] -> [(Mode_, Mode (CmdArgs Any))]
forall a b. (a -> b) -> [a] -> [b]
map (Mode_ -> Mode_
forall a. a -> a
id (Mode_ -> Mode_)
-> (Mode_ -> Mode (CmdArgs Any))
-> Mode_
-> (Mode_, Mode (CmdArgs Any))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Mode_ -> Mode (CmdArgs Any)
collapseMode) ([Mode_] -> [(Mode_, Mode (CmdArgs Any))])
-> [Mode_] -> [(Mode_, Mode (CmdArgs Any))]
forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
x
        auto :: [Mode (CmdArgs Any)]
auto = [Mode (CmdArgs Any)
m | (Mode_
m_,Mode (CmdArgs Any)
m) <- [(Mode_, Mode (CmdArgs Any))]
ms, Mode_ -> Bool
modeDefault Mode_
m_]


-- | A mode devoid of all it's contents
emptyMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
emptyMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
emptyMode Mode (CmdArgs Any)
x = Mode (CmdArgs Any)
x
    {modeCheck :: CmdArgs Any -> Either String (CmdArgs Any)
modeCheck = \CmdArgs Any
x -> if CmdArgs Any -> Bool
forall a. CmdArgs a -> Bool
cmdArgsHasValue CmdArgs Any
x then String -> Either String (CmdArgs Any)
forall a b. a -> Either a b
Left String
"No mode given and no default mode" else CmdArgs Any -> Either String (CmdArgs Any)
forall a b. b -> Either a b
Right CmdArgs Any
x
    ,modeGroupFlags :: Group (Flag (CmdArgs Any))
modeGroupFlags = Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any))
forall a. Group a -> Group a
groupUncommonDelete (Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any)))
-> Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any))
forall a b. (a -> b) -> a -> b
$ Mode (CmdArgs Any) -> Group (Flag (CmdArgs Any))
forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode (CmdArgs Any)
x
    ,modeArgs :: ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
modeArgs=([],Maybe (Arg (CmdArgs Any))
forall a. Maybe a
Nothing), modeHelpSuffix :: [String]
modeHelpSuffix=[]}

-- | A mode whose help hides all it's contents
zeroMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
zeroMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
zeroMode Mode (CmdArgs Any)
x = Mode (CmdArgs Any)
x
    {modeGroupFlags :: Group (Flag (CmdArgs Any))
modeGroupFlags = Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any))
forall a. Group a -> Group a
groupUncommonHide (Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any)))
-> Group (Flag (CmdArgs Any)) -> Group (Flag (CmdArgs Any))
forall a b. (a -> b) -> a -> b
$ Mode (CmdArgs Any) -> Group (Flag (CmdArgs Any))
forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode (CmdArgs Any)
x
    ,modeArgs :: ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
modeArgs = let zeroArg :: Arg a -> Arg a
zeroArg Arg a
x = Arg a
x{argType :: String
argType=String
""} in (Arg (CmdArgs Any) -> Arg (CmdArgs Any))
-> [Arg (CmdArgs Any)] -> [Arg (CmdArgs Any)]
forall a b. (a -> b) -> [a] -> [b]
map Arg (CmdArgs Any) -> Arg (CmdArgs Any)
forall a. Arg a -> Arg a
zeroArg ([Arg (CmdArgs Any)] -> [Arg (CmdArgs Any)])
-> (Maybe (Arg (CmdArgs Any)) -> Maybe (Arg (CmdArgs Any)))
-> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
-> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Arg (CmdArgs Any) -> Arg (CmdArgs Any))
-> Maybe (Arg (CmdArgs Any)) -> Maybe (Arg (CmdArgs Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg (CmdArgs Any) -> Arg (CmdArgs Any)
forall a. Arg a -> Arg a
zeroArg (([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
 -> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any))))
-> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
-> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
forall a b. (a -> b) -> a -> b
$ Mode (CmdArgs Any)
-> ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode (CmdArgs Any)
x
    ,modeHelpSuffix :: [String]
modeHelpSuffix=[]}


collapseMode :: Mode_ -> Mode (CmdArgs Any)
collapseMode :: Mode_ -> Mode (CmdArgs Any)
collapseMode Mode_
x =
    [Fixup] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
applyFixups ((Flag_ -> Fixup) -> [Flag_] -> [Fixup]
forall a b. (a -> b) -> [a] -> [b]
map Flag_ -> Fixup
flagFixup ([Flag_] -> [Fixup]) -> [Flag_] -> [Fixup]
forall a b. (a -> b) -> a -> b
$ Mode_ -> [Flag_]
modeFlags_ Mode_
x) (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$
    [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseArgs [Flag_
x | x :: Flag_
x@Arg_{} <- Mode_ -> [Flag_]
modeFlags_ Mode_
x] (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$
    [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseFlags [Flag_
x | x :: Flag_
x@Flag_{} <- Mode_ -> [Flag_]
modeFlags_ Mode_
x] (Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$
    Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x


applyFixups :: [Fixup] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
applyFixups :: [Fixup] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
applyFixups [Fixup]
xs Mode (CmdArgs Any)
m = Mode (CmdArgs Any)
m{modeCheck :: CmdArgs Any -> Either String (CmdArgs Any)
modeCheck = (String -> Either String (CmdArgs Any))
-> (CmdArgs Any -> Either String (CmdArgs Any))
-> Either String (CmdArgs Any)
-> Either String (CmdArgs Any)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (CmdArgs Any)
forall a b. a -> Either a b
Left (CmdArgs Any -> Either String (CmdArgs Any)
forall a b. b -> Either a b
Right (CmdArgs Any -> Either String (CmdArgs Any))
-> (CmdArgs Any -> CmdArgs Any)
-> CmdArgs Any
-> Either String (CmdArgs Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Any -> Any) -> CmdArgs Any -> CmdArgs Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> Any
fix) (Either String (CmdArgs Any) -> Either String (CmdArgs Any))
-> (CmdArgs Any -> Either String (CmdArgs Any))
-> CmdArgs Any
-> Either String (CmdArgs Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode (CmdArgs Any) -> CmdArgs Any -> Either String (CmdArgs Any)
forall a. Mode a -> a -> Either String a
modeCheck Mode (CmdArgs Any)
m}
    where fix :: Any -> Any
fix Any
a = ((Any -> Any) -> Any -> Any) -> Any -> [Any -> Any] -> Any
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Any -> Any) -> Any -> Any
forall a b. (a -> b) -> a -> b
($) Any
a [Any -> Any
x | Fixup Any -> Any
x <- [Fixup]
xs]


collapseFlags :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseFlags :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseFlags [Flag_]
xs Mode (CmdArgs Any)
x = Mode (CmdArgs Any)
x{modeGroupFlags :: Group (Flag (CmdArgs Any))
modeGroupFlags = [Flag (CmdArgs Any)]
-> [Flag (CmdArgs Any)]
-> [(String, [Flag (CmdArgs Any)])]
-> Group (Flag (CmdArgs Any))
forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group (Maybe String -> [Flag (CmdArgs Any)]
pick Maybe String
forall a. Maybe a
Nothing) [] [(String
g, Maybe String -> [Flag (CmdArgs Any)]
pick (Maybe String -> [Flag (CmdArgs Any)])
-> Maybe String -> [Flag (CmdArgs Any)]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
g) | String
g <- [String]
groups]}
    where
        pick :: Maybe String -> [Flag (CmdArgs Any)]
pick Maybe String
x = (Flag_ -> Flag (CmdArgs Any)) -> [Flag_] -> [Flag (CmdArgs Any)]
forall a b. (a -> b) -> [a] -> [b]
map Flag_ -> Flag (CmdArgs Any)
flagFlag ([Flag_] -> [Flag (CmdArgs Any)])
-> [Flag_] -> [Flag (CmdArgs Any)]
forall a b. (a -> b) -> a -> b
$ (Flag_ -> Bool) -> [Flag_] -> [Flag_]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe String
x (Maybe String -> Bool) -> (Flag_ -> Maybe String) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe String
flagGroup) [Flag_]
xs
        groups :: [String]
groups = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Flag_ -> Maybe String) -> [Flag_] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Flag_ -> Maybe String
flagGroup [Flag_]
xs


collapseArgs :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseArgs :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
collapseArgs [] Mode (CmdArgs Any)
x = Mode (CmdArgs Any)
x
collapseArgs [Flag_]
xs Mode (CmdArgs Any)
x = Mode (CmdArgs Any)
x{modeCheck :: CmdArgs Any -> Either String (CmdArgs Any)
modeCheck=CmdArgs Any -> Either String (CmdArgs Any)
chk, modeArgs :: ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
modeArgs = ([], Arg (CmdArgs Any) -> Maybe (Arg (CmdArgs Any))
forall a. a -> Maybe a
Just (Arg (CmdArgs Any) -> Maybe (Arg (CmdArgs Any)))
-> Arg (CmdArgs Any) -> Maybe (Arg (CmdArgs Any))
forall a b. (a -> b) -> a -> b
$ Update (CmdArgs Any) -> String -> Arg (CmdArgs Any)
forall a. Update a -> String -> Arg a
flagArg Update (CmdArgs Any)
upd String
hlp)}
    where
        argUpd :: Flag_ -> Update (CmdArgs Any)
argUpd = Arg (CmdArgs Any) -> Update (CmdArgs Any)
forall a. Arg a -> Update a
argValue (Arg (CmdArgs Any) -> Update (CmdArgs Any))
-> (Flag_ -> Arg (CmdArgs Any)) -> Flag_ -> Update (CmdArgs Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Arg (CmdArgs Any)
flagArg_

        ([Flag_]
ord,Maybe Flag_
rep) = [Flag_] -> ([Flag_], Maybe Flag_)
orderArgs [Flag_]
xs
        mn :: Int
mn = [Flag_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Flag_] -> Int) -> [Flag_] -> Int
forall a b. (a -> b) -> a -> b
$ (Flag_ -> Bool) -> [Flag_] -> [Flag_]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> (Flag_ -> Maybe String) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe String
flagArgOpt) ([Flag_] -> [Flag_]) -> [Flag_] -> [Flag_]
forall a b. (a -> b) -> a -> b
$ [Flag_] -> [Flag_]
forall a. [a] -> [a]
reverse [Flag_]
ord

        chk :: CmdArgs Any -> Either String (CmdArgs Any)
chk CmdArgs Any
v | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CmdArgs Any -> Bool
forall a. CmdArgs a -> Bool
cmdArgsHasValue CmdArgs Any
v = CmdArgs Any -> Either String (CmdArgs Any)
forall a b. b -> Either a b
Right CmdArgs Any
v
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn = String -> Either String (CmdArgs Any)
forall a b. a -> Either a b
Left (String -> Either String (CmdArgs Any))
-> String -> Either String (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ String
"Requires at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
              | Bool
otherwise = (Either String (CmdArgs Any)
 -> Flag_ -> Either String (CmdArgs Any))
-> Either String (CmdArgs Any)
-> [Flag_]
-> Either String (CmdArgs Any)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either String (CmdArgs Any) -> Flag_ -> Either String (CmdArgs Any)
f (Int -> CmdArgs Any -> Either String (CmdArgs Any)
addOptArgs Int
n CmdArgs Any
v) (Int -> [Flag_] -> [Flag_]
forall a. Int -> [a] -> [a]
drop Int
n [Flag_]
ord)
            where n :: Int
n = CmdArgs Any -> Int
forall a. CmdArgs a -> Int
getArgsSeen CmdArgs Any
v
                  f :: Either String (CmdArgs Any) -> Flag_ -> Either String (CmdArgs Any)
f (Right CmdArgs Any
v) Flag_
arg = Flag_ -> Update (CmdArgs Any)
argUpd Flag_
arg (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Flag_ -> Maybe String
flagArgOpt Flag_
arg) CmdArgs Any
v
                  f Either String (CmdArgs Any)
x Flag_
_ = Either String (CmdArgs Any)
x

        -- if we have repeating args which is also opt, translate that here
        addOptArgs :: Int -> CmdArgs Any -> Either String (CmdArgs Any)
addOptArgs Int
n CmdArgs Any
v
            | Just Flag_
x <- Maybe Flag_
rep, Just String
o <- Flag_ -> Maybe String
flagArgOpt Flag_
x, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Flag_ -> Bool) -> [Flag_] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> (Flag_ -> Maybe Int) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe Int
flagArgPos) ([Flag_]
ord [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++ [Flag_
x]) = Flag_ -> Update (CmdArgs Any)
argUpd Flag_
x String
o CmdArgs Any
v
            | Bool
otherwise = CmdArgs Any -> Either String (CmdArgs Any)
forall a b. b -> Either a b
Right CmdArgs Any
v

        hlp :: String
hlp = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++String
xString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]") [String]
b
            where ([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
mn ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (Flag_ -> String) -> [Flag_] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Arg (CmdArgs Any) -> String
forall a. Arg a -> String
argType (Arg (CmdArgs Any) -> String)
-> (Flag_ -> Arg (CmdArgs Any)) -> Flag_ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Arg (CmdArgs Any)
flagArg_) ([Flag_] -> [String]) -> [Flag_] -> [String]
forall a b. (a -> b) -> a -> b
$ [Flag_]
ord [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++ Maybe Flag_ -> [Flag_]
forall a. Maybe a -> [a]
maybeToList Maybe Flag_
rep

        upd :: Update (CmdArgs Any)
upd String
s CmdArgs Any
v | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Flag_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flag_]
ord = Flag_ -> Update (CmdArgs Any)
argUpd ([Flag_]
ord [Flag_] -> Int -> Flag_
forall a. [a] -> Int -> a
!! Int
n) String
s CmdArgs Any
v2
                | Just Flag_
x <- Maybe Flag_
rep = Flag_ -> Update (CmdArgs Any)
argUpd Flag_
x String
s CmdArgs Any
v2
                | Bool
otherwise = String -> Either String (CmdArgs Any)
forall a b. a -> Either a b
Left (String -> Either String (CmdArgs Any))
-> String -> Either String (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ String
"expected at most " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Flag_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flag_]
ord)
            where n :: Int
n = CmdArgs Any -> Int
forall a. CmdArgs a -> Int
getArgsSeen CmdArgs Any
v
                  v2 :: CmdArgs Any
v2 = CmdArgs Any -> CmdArgs Any
forall a. CmdArgs a -> CmdArgs a
incArgsSeen CmdArgs Any
v


-- return the arguments in order, plus those at the end
orderArgs :: [Flag_] -> ([Flag_], Maybe Flag_)
orderArgs :: [Flag_] -> ([Flag_], Maybe Flag_)
orderArgs [Flag_]
args = (Int -> [Flag_] -> [Flag_]
f Int
0 [Flag_]
ord, [Flag_] -> Maybe Flag_
forall a. [a] -> Maybe a
listToMaybe [Flag_]
rep)
    where
        ([Flag_]
rep,[Flag_]
ord) = (Flag_ -> Bool) -> [Flag_] -> ([Flag_], [Flag_])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> (Flag_ -> Maybe Int) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe Int
flagArgPos) ([Flag_] -> ([Flag_], [Flag_])) -> [Flag_] -> ([Flag_], [Flag_])
forall a b. (a -> b) -> a -> b
$ (Flag_ -> Flag_ -> Ordering) -> [Flag_] -> [Flag_]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe Int -> Maybe Int -> Ordering)
-> (Flag_ -> Maybe Int) -> Flag_ -> Flag_ -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Flag_ -> Maybe Int
flagArgPos) [Flag_]
args
        f :: Int -> [Flag_] -> [Flag_]
f Int
i [] = []
        f Int
i (Flag_
x:[Flag_]
xs) = case Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Flag_ -> Maybe Int
flagArgPos Flag_
x) Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
i of
            Ordering
LT -> Int -> [Flag_] -> [Flag_]
f Int
i [Flag_]
xs
            Ordering
EQ -> Flag_
x Flag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
: Int -> [Flag_] -> [Flag_]
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Flag_]
xs
            Ordering
GT -> Int -> [Flag_] -> [Flag_]
forall a. Int -> [a] -> [a]
take Int
1 [Flag_]
rep [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++ Int -> [Flag_] -> [Flag_]
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Flag_
xFlag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
:[Flag_]
xs)


---------------------------------------------------------------------
-- DEAL WITH GROUPS

assignGroups :: Prog_ -> Prog_
assignGroups :: Prog_ -> Prog_
assignGroups Prog_
p = Prog_ -> Prog_
assignCommon (Prog_ -> Prog_) -> Prog_ -> Prog_
forall a b. (a -> b) -> a -> b
$ Prog_
p{progModes :: [Mode_]
progModes = (Mode_ -> Mode_) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> [a] -> [b]
map (\Mode_
m -> Mode_
m{modeFlags_ :: [Flag_]
modeFlags_ = Maybe String -> [Flag_] -> [Flag_]
f Maybe String
forall a. Maybe a
Nothing ([Flag_] -> [Flag_]) -> [Flag_] -> [Flag_]
forall a b. (a -> b) -> a -> b
$ Mode_ -> [Flag_]
modeFlags_ Mode_
m}) ([Mode_] -> [Mode_]) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
p}
    where
        f :: Maybe String -> [Flag_] -> [Flag_]
f Maybe String
grp [] = []
        f Maybe String
grp (x :: Flag_
x@Flag_{}:[Flag_]
xs) = Flag_
x{flagGroup :: Maybe String
flagGroup=Maybe String
grp2} Flag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
: Maybe String -> [Flag_] -> [Flag_]
f Maybe String
grp2 [Flag_]
xs
            where grp2 :: Maybe String
grp2 = Flag_ -> Maybe String
flagGroup Flag_
x Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
grp
        f Maybe String
grp (Flag_
x:[Flag_]
xs) = Flag_
x Flag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
: Maybe String -> [Flag_] -> [Flag_]
f Maybe String
grp [Flag_]
xs


assignCommon :: Prog_ -> Prog_
assignCommon :: Prog_ -> Prog_
assignCommon Prog_
p =
    Prog_
p{progModes :: [Mode_]
progModes = [Mode_
m{modeFlags_ :: [Flag_]
modeFlags_ =
        [if Flag_ -> Bool
isFlag_ Flag_
f Bool -> Bool -> Bool
&& Flag (CmdArgs Any) -> String
forall a. Show a => a -> String
show (Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
f) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
com then Flag_
f{flagGroup :: Maybe String
flagGroup = String -> Maybe String
forall a. a -> Maybe a
Just String
commonGroup} else Flag_
f | Flag_
f <- Mode_ -> [Flag_]
modeFlags_ Mode_
m]}
    | Mode_
m <- Prog_ -> [Mode_]
progModes Prog_
p]}
    where
        com :: [String]
com = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. [a] -> a
head ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Mode_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
p)) (Int -> Bool) -> ([String] -> Int) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
group ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort
              [Flag (CmdArgs Any) -> String
forall a. Show a => a -> String
show (Flag (CmdArgs Any) -> String) -> Flag (CmdArgs Any) -> String
forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
f | Mode_
m <- Prog_ -> [Mode_]
progModes Prog_
p, f :: Flag_
f@Flag_{flagGroup :: Flag_ -> Maybe String
flagGroup=Maybe String
Nothing} <- Mode_ -> [Flag_]
modeFlags_ Mode_
m]


commonGroup :: String
commonGroup = String
"Common flags"

groupSplitCommon :: Group a -> ([a], Group a)
groupSplitCommon :: Group a -> ([a], Group a)
groupSplitCommon (Group [a]
unnamed [a]
hidden [(String, [a])]
named) = (((String, [a]) -> [a]) -> [(String, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [a]) -> [a]
forall a b. (a, b) -> b
snd [(String, [a])]
com, [a] -> [a] -> [(String, [a])] -> Group a
forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [a]
unnamed [a]
hidden [(String, [a])]
uni)
    where ([(String, [a])]
com,[(String, [a])]
uni) = ((String, [a]) -> Bool)
-> [(String, [a])] -> ([(String, [a])], [(String, [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
commonGroup (String -> Bool)
-> ((String, [a]) -> String) -> (String, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [a]) -> String
forall a b. (a, b) -> a
fst) [(String, [a])]
named

groupCommonHide :: Group a -> Group a
groupCommonHide Group a
x = let ([a]
a,Group a
b) = Group a -> ([a], Group a)
forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in Group a
b{groupHidden :: [a]
groupHidden = Group a -> [a]
forall a. Group a -> [a]
groupHidden Group a
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
a}
groupUncommonHide :: Group a -> Group a
groupUncommonHide Group a
x = let ([a]
a,Group a
b) = Group a -> ([a], Group a)
forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in [a] -> [a] -> [(String, [a])] -> Group a
forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [] (Group a -> [a]
forall a. Group a -> [a]
fromGroup Group a
b) [(String
commonGroup,[a]
a) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a]
groupUncommonDelete :: Group a -> Group a
groupUncommonDelete Group a
x = let a :: [a]
a = ([a], Group a) -> [a]
forall a b. (a, b) -> a
fst (([a], Group a) -> [a]) -> ([a], Group a) -> [a]
forall a b. (a -> b) -> a -> b
$ Group a -> ([a], Group a)
forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in [a] -> [a] -> [(String, [a])] -> Group a
forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [] [] [(String
commonGroup,[a]
a) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a]


---------------------------------------------------------------------
-- ADD EXTRA PIECES

extraFlags :: Prog_ -> Prog_
extraFlags :: Prog_ -> Prog_
extraFlags Prog_
p = Prog_
p{progModes :: [Mode_]
progModes = (Mode_ -> Mode_) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> [a] -> [b]
map Mode_ -> Mode_
f ([Mode_] -> [Mode_]) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
p}
    where f :: Mode_ -> Mode_
f Mode_
m = Mode_
m{modeFlags_ :: [Flag_]
modeFlags_ = Mode_ -> [Flag_]
modeFlags_ Mode_
m [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++ [Flag_]
flags}
          grp :: Maybe String
grp = if [Mode_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
p) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String -> Maybe String
forall a. a -> Maybe a
Just String
commonGroup else Maybe String
forall a. Maybe a
Nothing
          wrap :: Flag (CmdArgs Any) -> Flag_
wrap Flag (CmdArgs Any)
x = Flag_
forall a. Default a => a
def{flagFlag :: Flag (CmdArgs Any)
flagFlag=Flag (CmdArgs Any)
x, flagExplicit :: Bool
flagExplicit=Bool
True, flagGroup :: Maybe String
flagGroup=Maybe String
grp}
          flags :: [Flag_]
flags = Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ (Prog_ -> Maybe Builtin_
progHelpArg Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap (Flag (CmdArgs Any) -> Flag_) -> Flag (CmdArgs Any) -> Flag_
forall a b. (a -> b) -> a -> b
$ (HelpFormat -> TextFormat -> CmdArgs Any -> CmdArgs Any)
-> Flag (CmdArgs Any)
forall a. (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat ((HelpFormat -> TextFormat -> CmdArgs Any -> CmdArgs Any)
 -> Flag (CmdArgs Any))
-> (HelpFormat -> TextFormat -> CmdArgs Any -> CmdArgs Any)
-> Flag (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ String -> HelpFormat -> TextFormat -> CmdArgs Any -> CmdArgs Any
forall a. HasCallStack => String -> a
error String
"flagHelpFormat undefined") [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ (Prog_ -> Maybe Builtin_
progVersionArg Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap (Flag (CmdArgs Any) -> Flag_) -> Flag (CmdArgs Any) -> Flag_
forall a b. (a -> b) -> a -> b
$ (CmdArgs Any -> CmdArgs Any) -> Flag (CmdArgs Any)
forall a. (a -> a) -> Flag a
flagVersion CmdArgs Any -> CmdArgs Any
forall a. CmdArgs a -> CmdArgs a
vers) [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++
                  [Flag (CmdArgs Any) -> Flag_
wrap (Flag (CmdArgs Any) -> Flag_) -> Flag (CmdArgs Any) -> Flag_
forall a b. (a -> b) -> a -> b
$ (CmdArgs Any -> CmdArgs Any) -> Flag (CmdArgs Any)
forall a. (a -> a) -> Flag a
flagNumericVersion ((CmdArgs Any -> CmdArgs Any) -> Flag (CmdArgs Any))
-> (CmdArgs Any -> CmdArgs Any) -> Flag (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ \CmdArgs Any
x -> CmdArgs Any
x{cmdArgsVersion :: Maybe String
cmdArgsVersion = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
v}
                        | Just [String]
v <- [Prog_ -> Maybe [String]
forall (m :: * -> *). Monad m => Prog_ -> Maybe (m String)
progNumericVersionOutput Prog_
p]] [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ ((Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_
forall a b. (a, b) -> a
fst ((Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_)
-> (Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_
forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap Flag (CmdArgs Any)
forall a. Flag (CmdArgs a)
loud) [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ ((Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_
forall a b. (a, b) -> b
snd ((Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_)
-> (Maybe Builtin_, Maybe Builtin_) -> Maybe Builtin_
forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap Flag (CmdArgs Any)
forall a. Flag (CmdArgs a)
quiet)
          [Flag (CmdArgs a)
loud,Flag (CmdArgs a)
quiet] = (Verbosity -> CmdArgs a -> CmdArgs a) -> [Flag (CmdArgs a)]
forall a. (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity Verbosity -> CmdArgs a -> CmdArgs a
forall a. Verbosity -> CmdArgs a -> CmdArgs a
verb
          vers :: CmdArgs a -> CmdArgs a
vers CmdArgs a
x = CmdArgs a
x{cmdArgsVersion :: Maybe String
cmdArgsVersion = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Prog_ -> [String]
progVersionOutput Prog_
p}
          verb :: Verbosity -> CmdArgs a -> CmdArgs a
verb Verbosity
v CmdArgs a
x = CmdArgs a
x{cmdArgsVerbosity :: Maybe Verbosity
cmdArgsVerbosity = Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
v}


changeBuiltin :: Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin :: Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin Maybe Builtin_
Nothing Flag a
_ = []
changeBuiltin (Just Builtin_{Bool
[String]
Maybe String
Maybe [String]
builtinSummary :: Builtin_ -> Maybe [String]
builtinGroup :: Builtin_ -> Maybe String
builtinHelp :: Builtin_ -> Maybe String
builtinExplicit :: Builtin_ -> Bool
builtinNames :: Builtin_ -> [String]
builtinSummary :: Maybe [String]
builtinGroup :: Maybe String
builtinHelp :: Maybe String
builtinExplicit :: Bool
builtinNames :: [String]
..}) Flag a
x = [Flag a
x
    {flagNames :: [String]
flagNames = [String]
builtinNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Bool
builtinExplicit then [] else Flag a -> [String]
forall a. Flag a -> [String]
flagNames Flag a
x
    ,flagHelp :: String
flagHelp = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Flag a -> String
forall a. Flag a -> String
flagHelp Flag a
x) Maybe String
builtinHelp}]

changeBuiltin_ :: Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ :: Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ Maybe Builtin_
Nothing Flag_
_ = []
changeBuiltin_ (Just Builtin_
b) Flag_
x = [Flag_
x{flagFlag :: Flag (CmdArgs Any)
flagFlag=Flag (CmdArgs Any)
y, flagGroup :: Maybe String
flagGroup = Builtin_ -> Maybe String
builtinGroup Builtin_
b Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Flag_ -> Maybe String
flagGroup Flag_
x}
    | Flag (CmdArgs Any)
y <- Maybe Builtin_ -> Flag (CmdArgs Any) -> [Flag (CmdArgs Any)]
forall a. Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin (Builtin_ -> Maybe Builtin_
forall a. a -> Maybe a
Just Builtin_
b) (Flag (CmdArgs Any) -> [Flag (CmdArgs Any)])
-> Flag (CmdArgs Any) -> [Flag (CmdArgs Any)]
forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x]


setHelp :: Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
setHelp :: Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
setHelp Prog_
p = (String -> Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> String -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a.
(String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes0 String -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a. String -> Mode (CmdArgs a) -> Mode (CmdArgs a)
add String
""
    where
        mapModes0 :: (String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes0 String -> Mode a -> Mode a
f String
pre Mode a
m = String -> Mode a -> Mode a
f String
pre (Mode a -> Mode a) -> Mode a -> Mode a
forall a b. (a -> b) -> a -> b
$ (String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes1 String -> Mode a -> Mode a
f String
pre Mode a
m
        mapModes1 :: (String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes1 String -> Mode a -> Mode a
f String
pre Mode a
m = Mode a
m{modeGroupModes :: Group (Mode a)
modeGroupModes = (Mode a -> Mode a) -> Group (Mode a) -> Group (Mode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes0 String -> Mode a -> Mode a
f (String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
head (Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ")) (Group (Mode a) -> Group (Mode a))
-> Group (Mode a) -> Group (Mode a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m}

        add :: String -> Mode (CmdArgs a) -> Mode (CmdArgs a)
add String
pre Mode (CmdArgs a)
m = Prog_
-> Mode (CmdArgs a)
-> (HelpFormat -> TextFormat -> CmdArgs a -> CmdArgs a)
-> Mode (CmdArgs a)
forall a.
Prog_ -> Mode a -> (HelpFormat -> TextFormat -> a -> a) -> Mode a
changeHelp Prog_
p Mode (CmdArgs a)
m ((HelpFormat -> TextFormat -> CmdArgs a -> CmdArgs a)
 -> Mode (CmdArgs a))
-> (HelpFormat -> TextFormat -> CmdArgs a -> CmdArgs a)
-> Mode (CmdArgs a)
forall a b. (a -> b) -> a -> b
$ \HelpFormat
hlp TextFormat
txt CmdArgs a
x -> CmdArgs a
x{cmdArgsHelp :: Maybe String
cmdArgsHelp=String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TextFormat -> [Text] -> String
showText TextFormat
txt ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$ HelpFormat -> [Text]
msg HelpFormat
hlp}
            where msg :: HelpFormat -> [Text]
msg HelpFormat
hlp = [String] -> HelpFormat -> Mode (CmdArgs a) -> [Text]
forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText (Prog_ -> [String]
progHelpOutput Prog_
p) HelpFormat
hlp (Mode (CmdArgs a) -> Mode (CmdArgs a)
forall a. Mode a -> Mode a
prepare Mode (CmdArgs a)
m{modeNames :: [String]
modeNames = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
preString -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode (CmdArgs a) -> [String]
forall a. Mode a -> [String]
modeNames Mode (CmdArgs a)
m})

        prepare :: Mode a -> Mode a
prepare = (String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
forall a.
(String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes1 (\String
_ Mode a
m -> Mode a
m{modeGroupFlags :: Group (Flag a)
modeGroupFlags = Group (Flag a) -> Group (Flag a)
forall a. Group a -> Group a
groupCommonHide (Group (Flag a) -> Group (Flag a))
-> Group (Flag a) -> Group (Flag a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Flag a)
forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
m}) String
""


changeHelp :: Prog_ -> Mode a -> (HelpFormat -> TextFormat -> a -> a) -> Mode a
changeHelp :: Prog_ -> Mode a -> (HelpFormat -> TextFormat -> a -> a) -> Mode a
changeHelp Prog_
p Mode a
m HelpFormat -> TextFormat -> a -> a
upd = Mode a
m{modeGroupFlags :: Group (Flag a)
modeGroupFlags = (Flag a -> Flag a) -> Group (Flag a) -> Group (Flag a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Flag a -> Flag a
f (Group (Flag a) -> Group (Flag a))
-> Group (Flag a) -> Group (Flag a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Flag a)
forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
m}
    where hlp :: [Flag a]
hlp = Maybe Builtin_ -> Flag a -> [Flag a]
forall a. Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin (Prog_ -> Maybe Builtin_
progHelpArg Prog_
p) (Flag a -> [Flag a]) -> Flag a -> [Flag a]
forall a b. (a -> b) -> a -> b
$ (HelpFormat -> TextFormat -> a -> a) -> Flag a
forall a. (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat HelpFormat -> TextFormat -> a -> a
upd
          f :: Flag a -> Flag a
f Flag a
flg = if (Flag a -> [String]) -> [Flag a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag a -> [String]
forall a. Flag a -> [String]
flagNames [Flag a]
hlp [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== Flag a -> [String]
forall a. Flag a -> [String]
flagNames Flag a
flg then [Flag a] -> Flag a
forall a. [a] -> a
head [Flag a]
hlp else Flag a
flg


setReform :: (a -> Maybe [String]) -> Mode a -> Mode a
setReform :: (a -> Maybe [String]) -> Mode a -> Mode a
setReform a -> Maybe [String]
f Mode a
m = Mode a
m{modeReform :: a -> Maybe [String]
modeReform = a -> Maybe [String]
f, modeGroupModes :: Group (Mode a)
modeGroupModes = (Mode a -> Mode a) -> Group (Mode a) -> Group (Mode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe [String]) -> Mode a -> Mode a
forall a. (a -> Maybe [String]) -> Mode a -> Mode a
setReform a -> Maybe [String]
f) (Group (Mode a) -> Group (Mode a))
-> Group (Mode a) -> Group (Mode a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m}


---------------------------------------------------------------------
-- ASSIGN NAMES

assignNames :: Prog_ -> Prog_
assignNames :: Prog_ -> Prog_
assignNames Prog_
x = Prog_
x{progModes :: [Mode_]
progModes = (Mode_ -> Mode_) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> [a] -> [b]
map Mode_ -> Mode_
f ([Mode_] -> [Mode_]) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> a -> b
$ (Mode_ -> Names)
-> ([String] -> Mode_ -> Mode_) -> [Mode_] -> [Mode_]
forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Mode_ -> Names
fromMode [String] -> Mode_ -> Mode_
toMode ([Mode_] -> [Mode_]) -> [Mode_] -> [Mode_]
forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
x}
    where
        fromMode :: Mode_ -> Names
fromMode Mode_
x = [String] -> [String] -> Names
Names (Mode (CmdArgs Any) -> [String]
forall a. Mode a -> [String]
modeNames (Mode (CmdArgs Any) -> [String]) -> Mode (CmdArgs Any) -> [String]
forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x) [String -> String
asName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Any -> String
ctor (Any -> String) -> Any -> String
forall a b. (a -> b) -> a -> b
$ CmdArgs Any -> Any
forall a. CmdArgs a -> a
cmdArgsValue (CmdArgs Any -> Any) -> CmdArgs Any -> Any
forall a b. (a -> b) -> a -> b
$ Mode (CmdArgs Any) -> CmdArgs Any
forall a. Mode a -> a
modeValue (Mode (CmdArgs Any) -> CmdArgs Any)
-> Mode (CmdArgs Any) -> CmdArgs Any
forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Mode_ -> Bool
modeExplicit Mode_
x]
        toMode :: [String] -> Mode_ -> Mode_
toMode [String]
xs Mode_
x = Mode_
x{modeMode :: Mode (CmdArgs Any)
modeMode = (Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x){modeNames :: [String]
modeNames=[String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. [a] -> a
head [String]
xsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]" | Mode_ -> Bool
modeDefault Mode_
x] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xs}}

        fromFlagLong :: Flag_ -> Names
fromFlagLong Flag_
x = [String] -> [String] -> Names
Names (Flag (CmdArgs Any) -> [String]
forall a. Flag a -> [String]
flagNames (Flag (CmdArgs Any) -> [String]) -> Flag (CmdArgs Any) -> [String]
forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x) [String -> String
asName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Flag_ -> String
flagField Flag_
x) (Flag_ -> Maybe String
flagEnum Flag_
x) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Flag_ -> Bool
flagExplicit Flag_
x]
        fromFlagShort :: Flag_ -> Names
fromFlagShort Flag_
x = [String] -> [String] -> Names
Names [String]
ns ([String] -> Names) -> [String] -> Names
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
s | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Flag_ -> Bool
flagExplicit Flag_
x, (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Int
1 (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
ns, String
s <- [String]
ns]
            where ns :: [String]
ns = Flag (CmdArgs Any) -> [String]
forall a. Flag a -> [String]
flagNames (Flag (CmdArgs Any) -> [String]) -> Flag (CmdArgs Any) -> [String]
forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x
        toFlag :: [String] -> Flag_ -> Flag_
toFlag [String]
xs Flag_
x = Flag_
x{flagFlag :: Flag (CmdArgs Any)
flagFlag = (Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x){flagNames :: [String]
flagNames=[String]
xs}}

        f :: Mode_ -> Mode_
f Mode_
x = Mode_
x{modeFlags_ :: [Flag_]
modeFlags_ = [Flag_]
rest [Flag_] -> [Flag_] -> [Flag_]
forall a. [a] -> [a] -> [a]
++ (Flag_ -> Names)
-> ([String] -> Flag_ -> Flag_) -> [Flag_] -> [Flag_]
forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Flag_ -> Names
fromFlagShort [String] -> Flag_ -> Flag_
toFlag ((Flag_ -> Names)
-> ([String] -> Flag_ -> Flag_) -> [Flag_] -> [Flag_]
forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Flag_ -> Names
fromFlagLong [String] -> Flag_ -> Flag_
toFlag [Flag_]
flgs)}
            where ([Flag_]
flgs,[Flag_]
rest) = (Flag_ -> Bool) -> [Flag_] -> ([Flag_], [Flag_])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Flag_ -> Bool
isFlag_ ([Flag_] -> ([Flag_], [Flag_])) -> [Flag_] -> ([Flag_], [Flag_])
forall a b. (a -> b) -> a -> b
$ Mode_ -> [Flag_]
modeFlags_ Mode_
x

        isFlag_ :: Flag_ -> Bool
isFlag_ Flag_{} = Bool
True
        isFlag_ Flag_
_ = Bool
False


asName :: String -> String
asName String
s = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' else Char -> Char
toLower Char
x) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ if String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then String -> String
forall a. [a] -> [a]
init String
s else String
s

-- have are already assigned, want are a list of ones I might want
data Names = Names {Names -> [String]
have :: [String], Names -> [String]
want :: [String]}

-- error out if any name is by multiple have's, or one item would get no names
names :: [Names] -> [[String]]
names :: [Names] -> [[String]]
names [Names]
xs | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad = String -> String -> [[String]]
forall a. String -> String -> a
err String
"repeated names" (String -> [[String]]) -> String -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
bad
    where bad :: [String]
bad = [String] -> [String]
forall a. Eq a => [a] -> [a]
duplicates ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Names -> [String]) -> [Names] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Names -> [String]
have [Names]
xs

names [Names]
xs | ([String] -> Bool) -> [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[String]]
res = String -> String -> [[String]]
forall a. String -> String -> a
err String
"no available name" String
"?"
         | Bool
otherwise = [[String]]
res
    where
        bad :: [String]
bad = (Names -> [String]) -> [Names] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Names -> [String]
have [Names]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
forall a. Eq a => [a] -> [a]
duplicates ((Names -> [String]) -> [Names] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Names -> [String]
want [Names]
xs)
        res :: [[String]]
res = (Names -> [String]) -> [Names] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\Names
x -> Names -> [String]
have Names
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Names -> [String]
want Names
x [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
bad)) [Names]
xs


duplicates :: Eq a => [a] -> [a]
duplicates :: [a] -> [a]
duplicates [a]
xs = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs


namesOn :: (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn :: (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn a -> Names
f [String] -> a -> a
g [a]
xs = ([String] -> a -> a) -> [[String]] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> a -> a
g ([Names] -> [[String]]
names ([Names] -> [[String]]) -> [Names] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (a -> Names) -> [a] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map a -> Names
f [a]
xs) [a]
xs