{-# 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 = forall a. (a -> Maybe [String]) -> Mode a -> Mode a
setReform (Prog_ -> CmdArgs Any -> Maybe [String]
reform Prog_
y) forall a b. (a -> b) -> a -> b
$ Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
setHelp Prog_
y forall a b. (a -> b) -> a -> b
$ forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
x forall a b. (a -> b) -> a -> b
$ Prog_ -> Mode (CmdArgs Any)
collapse forall a b. (a -> b) -> a -> b
$ Prog_ -> Prog_
assignGroups Prog_
y
    where y :: Prog_
y = Prog_ -> Prog_
assignNames forall a b. (a -> b) -> a -> b
$ Prog_ -> Prog_
extraFlags Prog_
x


setProgOpts :: Prog_ -> Mode a -> Mode a
setProgOpts :: forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
p Mode a
m = Mode a
m{modeExpandAt :: Bool
modeExpandAt = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Prog_ -> Bool
progNoAtExpand Prog_
p
                   ,modeGroupModes :: Group (Mode a)
modeGroupModes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
p) forall a b. (a -> b) -> a -> b
$ 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 | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Mode_, Mode (CmdArgs Any))]
ms forall a. Eq a => a -> a -> Bool
== Int
1 = (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Mode_, Mode (CmdArgs Any))]
ms){modeNames :: [String]
modeNames=[Prog_ -> String
progProgram Prog_
x]}
           | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mode (CmdArgs Any)]
auto forall a. Ord a => a -> a -> Bool
> Int
1 = forall {a}. String -> String -> a
err String
"prog" String
"Multiple automatic modes"
           | Bool
otherwise = (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Mode (CmdArgs Any) -> Mode (CmdArgs Any)
zeroMode [Mode (CmdArgs Any)]
auto forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Mode (CmdArgs Any) -> Mode (CmdArgs Any)
emptyMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group (Maybe String -> [Mode (CmdArgs Any)]
pick forall a. Maybe a
Nothing) [] [(String
g, Maybe String -> [Mode (CmdArgs Any)]
pick forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
g) | String
g <- forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Mode_ -> Maybe String
modeGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ forall a. Eq a => a -> a -> Bool
== Maybe String
x]

        ms :: [(Mode_, Mode (CmdArgs Any))]
ms = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Mode_ -> Mode (CmdArgs Any)
collapseMode) 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 forall a. CmdArgs a -> Bool
cmdArgsHasValue CmdArgs Any
x then forall a b. a -> Either a b
Left String
"No mode given and no default mode" else forall a b. b -> Either a b
Right CmdArgs Any
x
    ,modeGroupFlags :: Group (Flag (CmdArgs Any))
modeGroupFlags = forall {a}. Group a -> Group a
groupUncommonDelete forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode (CmdArgs Any)
x
    ,modeArgs :: ([Arg (CmdArgs Any)], Maybe (Arg (CmdArgs Any)))
modeArgs=([],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 = forall {a}. Group a -> Group a
groupUncommonHide forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Arg a -> Arg a
zeroArg 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 {a}. Arg a -> Arg a
zeroArg forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (a -> b) -> [a] -> [b]
map Flag_ -> Fixup
flagFixup forall a b. (a -> b) -> a -> b
$ Mode_ -> [Flag_]
modeFlags_ Mode_
x) 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] 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] 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> Any
fix) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Mode a -> a -> Either String a
modeCheck Mode (CmdArgs Any)
m}
    where fix :: Any -> Any
fix Any
a = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 = forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group (Maybe String -> [Flag (CmdArgs Any)]
pick forall a. Maybe a
Nothing) [] [(String
g, Maybe String -> [Flag (CmdArgs Any)]
pick forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
g) | String
g <- [String]
groups]}
    where
        pick :: Maybe String -> [Flag (CmdArgs Any)]
pick Maybe String
x = forall a b. (a -> b) -> [a] -> [b]
map Flag_ -> Flag (CmdArgs Any)
flagFlag forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) Maybe String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe String
flagGroup) [Flag_]
xs
        groups :: [String]
groups = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ 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 = ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Update a -> String -> Arg a
flagArg String -> CmdArgs Any -> Either String (CmdArgs Any)
upd String
hlp)}
    where
        argUpd :: Flag_ -> String -> CmdArgs Any -> Either String (CmdArgs Any)
argUpd = forall a. Arg a -> Update a
argValue 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe String
flagArgOpt) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Flag_]
ord

        chk :: CmdArgs Any -> Either String (CmdArgs Any)
chk CmdArgs Any
v | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. CmdArgs a -> Bool
cmdArgsHasValue CmdArgs Any
v = forall a b. b -> Either a b
Right CmdArgs Any
v
              | Int
n forall a. Ord a => a -> a -> Bool
< Int
mn = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Requires at least " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
mn forall a. [a] -> [a] -> [a]
++ String
" arguments, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
              | Bool
otherwise = 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) (forall a. Int -> [a] -> [a]
drop Int
n [Flag_]
ord)
            where n :: Int
n = 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_ -> String -> CmdArgs Any -> Either String (CmdArgs Any)
argUpd Flag_
arg (forall a. HasCallStack => Maybe a -> a
fromJust 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, forall a. a -> Maybe a
Just Int
n forall a. Ord a => a -> a -> Bool
<= forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe Int
flagArgPos) ([Flag_]
ord forall a. [a] -> [a] -> [a]
++ [Flag_
x]) = Flag_ -> String -> CmdArgs Any -> Either String (CmdArgs Any)
argUpd Flag_
x String
o CmdArgs Any
v
            | Bool
otherwise = forall a b. b -> Either a b
Right CmdArgs Any
v

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

        upd :: String -> CmdArgs Any -> Either String (CmdArgs Any)
upd String
s CmdArgs Any
v | Int
n forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flag_]
ord = Flag_ -> String -> CmdArgs Any -> Either String (CmdArgs Any)
argUpd ([Flag_]
ord forall a. [a] -> Int -> a
!! Int
n) String
s CmdArgs Any
v2
                | Just Flag_
x <- Maybe Flag_
rep = Flag_ -> String -> CmdArgs Any -> Either String (CmdArgs Any)
argUpd Flag_
x String
s CmdArgs Any
v2
                | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"expected at most " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flag_]
ord)
            where n :: Int
n = forall {a}. CmdArgs a -> Int
getArgsSeen CmdArgs Any
v
                  v2 :: CmdArgs Any
v2 = 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, forall a. [a] -> Maybe a
listToMaybe [Flag_]
rep)
    where
        ([Flag_]
rep,[Flag_]
ord) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe Int
flagArgPos) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare 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 forall a. HasCallStack => Maybe a -> a
fromJust (Flag_ -> Maybe Int
flagArgPos Flag_
x) 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 forall a. a -> [a] -> [a]
: Int -> [Flag_] -> [Flag_]
f (Int
iforall a. Num a => a -> a -> a
+Int
1) [Flag_]
xs
            Ordering
GT -> forall a. Int -> [a] -> [a]
take Int
1 [Flag_]
rep forall a. [a] -> [a] -> [a]
++ Int -> [Flag_] -> [Flag_]
f (Int
iforall a. Num a => a -> a -> a
+Int
1) (Flag_
xforall a. a -> [a] -> [a]
:[Flag_]
xs)


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

assignGroups :: Prog_ -> Prog_
assignGroups :: Prog_ -> Prog_
assignGroups Prog_
p = Prog_ -> Prog_
assignCommon forall a b. (a -> b) -> a -> b
$ Prog_
p{progModes :: [Mode_]
progModes = forall a b. (a -> b) -> [a] -> [b]
map (\Mode_
m -> Mode_
m{modeFlags_ :: [Flag_]
modeFlags_ = Maybe String -> [Flag_] -> [Flag_]
f forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Mode_ -> [Flag_]
modeFlags_ Mode_
m}) 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} 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 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 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
&& forall a. Show a => a -> String
show (Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
f) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
com then Flag_
f{flagGroup :: Maybe String
flagGroup = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
p)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [[a]]
group forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort
              [forall a. Show a => a -> String
show 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 :: forall a. Group a -> ([a], Group a)
groupSplitCommon (Group [a]
unnamed [a]
hidden [(String, [a])]
named) = (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(String, [a])]
com, forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [a]
unnamed [a]
hidden [(String, [a])]
uni)
    where ([(String, [a])]
com,[(String, [a])]
uni) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => a -> a -> Bool
(==) String
commonGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in Group a
b{groupHidden :: [a]
groupHidden = forall a. Group a -> [a]
groupHidden Group a
b forall a. [a] -> [a] -> [a]
++ [a]
a}
groupUncommonHide :: Group a -> Group a
groupUncommonHide Group a
x = let ([a]
a,Group a
b) = forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [] (forall a. Group a -> [a]
fromGroup Group a
b) [(String
commonGroup,[a]
a) | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a]
groupUncommonDelete :: Group a -> Group a
groupUncommonDelete Group a
x = let a :: [a]
a = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Group a -> ([a], Group a)
groupSplitCommon Group a
x in forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group [] [] [(String
commonGroup,[a]
a) | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map Mode_ -> Mode_
f 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 forall a. [a] -> [a] -> [a]
++ [Flag_]
flags}
          grp :: Maybe String
grp = if forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
p) forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just String
commonGroup else forall a. Maybe a
Nothing
          wrap :: Flag (CmdArgs Any) -> Flag_
wrap Flag (CmdArgs Any)
x = 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 forall a b. (a -> b) -> a -> b
$ forall a. (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"flagHelpFormat undefined") forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ (Prog_ -> Maybe Builtin_
progVersionArg Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Flag a
flagVersion forall {a}. CmdArgs a -> CmdArgs a
vers) forall a. [a] -> [a] -> [a]
++
                  [Flag (CmdArgs Any) -> Flag_
wrap forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Flag a
flagNumericVersion forall a b. (a -> b) -> a -> b
$ \CmdArgs Any
x -> CmdArgs Any
x{cmdArgsVersion :: Maybe String
cmdArgsVersion = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
v}
                        | Just [String]
v <- [forall {m :: * -> *}. Monad m => Prog_ -> Maybe (m String)
progNumericVersionOutput Prog_
p]] forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap forall {a}. Flag (CmdArgs a)
loud) forall a. [a] -> [a] -> [a]
++
                  Maybe Builtin_ -> Flag_ -> [Flag_]
changeBuiltin_ (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
p) (Flag (CmdArgs Any) -> Flag_
wrap forall {a}. Flag (CmdArgs a)
quiet)
          [Flag (CmdArgs a)
loud,Flag (CmdArgs a)
quiet] = forall a. (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity forall {a}. Verbosity -> CmdArgs a -> CmdArgs a
verb
          vers :: CmdArgs a -> CmdArgs a
vers CmdArgs a
x = CmdArgs a
x{cmdArgsVersion :: Maybe String
cmdArgsVersion = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines 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 = forall a. a -> Maybe a
Just Verbosity
v}


changeBuiltin :: Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin :: forall a. 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 forall a. [a] -> [a] -> [a]
++ if Bool
builtinExplicit then [] else forall a. Flag a -> [String]
flagNames Flag a
x
    ,flagHelp :: String
flagHelp = forall a. a -> Maybe a -> a
fromMaybe (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 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Flag_ -> Maybe String
flagGroup Flag_
x}
    | Flag (CmdArgs Any)
y <- forall a. Maybe Builtin_ -> Flag a -> [Flag a]
changeBuiltin (forall a. a -> Maybe a
Just Builtin_
b) 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 = forall {a}.
(String -> Mode a -> Mode a) -> String -> Mode a -> Mode a
mapModes0 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 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 = 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 forall a. [a] -> [a] -> [a]
++ forall a. [a] -> a
head (forall a. Mode a -> [String]
modeNames Mode a
m) forall a. [a] -> [a] -> [a]
++ String
" ")) forall a b. (a -> b) -> a -> b
$ 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 = forall a.
Prog_ -> Mode a -> (HelpFormat -> TextFormat -> a -> a) -> Mode a
changeHelp Prog_
p Mode (CmdArgs a)
m forall a b. (a -> b) -> a -> b
$ \HelpFormat
hlp TextFormat
txt CmdArgs a
x -> CmdArgs a
x{cmdArgsHelp :: Maybe String
cmdArgsHelp=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextFormat -> [Text] -> String
showText TextFormat
txt forall a b. (a -> b) -> a -> b
$ HelpFormat -> [Text]
msg HelpFormat
hlp}
            where msg :: HelpFormat -> [Text]
msg HelpFormat
hlp = forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText (Prog_ -> [String]
progHelpOutput Prog_
p) HelpFormat
hlp (forall {a}. Mode a -> Mode a
prepare Mode (CmdArgs a)
m{modeNames :: [String]
modeNames = forall a b. (a -> b) -> [a] -> [b]
map (String
preforall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode (CmdArgs a)
m})

        prepare :: Mode a -> Mode a
prepare = 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 = forall {a}. Group a -> Group a
groupCommonHide forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
m}) String
""


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


setReform :: (a -> Maybe [String]) -> Mode a -> Mode a
setReform :: forall a. (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Maybe [String]) -> Mode a -> Mode a
setReform a -> Maybe [String]
f) forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map Mode_ -> Mode_
f forall a b. (a -> b) -> a -> b
$ forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Mode_ -> Names
fromMode [String] -> Mode_ -> Mode_
toMode forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
x}
    where
        fromMode :: Mode_ -> Names
fromMode Mode_
x = [String] -> [String] -> Names
Names (forall a. Mode a -> [String]
modeNames forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x) [String -> String
asName forall a b. (a -> b) -> a -> b
$ Any -> String
ctor forall a b. (a -> b) -> a -> b
$ forall a. CmdArgs a -> a
cmdArgsValue forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> a
modeValue forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x | Bool -> Bool
not 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
"["forall a. [a] -> [a] -> [a]
++forall a. [a] -> a
head [String]
xsforall a. [a] -> [a] -> [a]
++String
"]" | Mode_ -> Bool
modeDefault Mode_
x] forall a. [a] -> [a] -> [a]
++ [String]
xs}}

        fromFlagLong :: Flag_ -> Names
fromFlagLong Flag_
x = [String] -> [String] -> Names
Names (forall a. Flag a -> [String]
flagNames forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x) [String -> String
asName forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Flag_ -> String
flagField Flag_
x) (Flag_ -> Maybe String
flagEnum Flag_
x) | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Flag_ -> Bool
flagExplicit Flag_
x]
        fromFlagShort :: Flag_ -> Names
fromFlagShort Flag_
x = [String] -> [String] -> Names
Names [String]
ns forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub [forall a. Int -> [a] -> [a]
take Int
1 String
s | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Flag_ -> Bool
flagExplicit Flag_
x, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
(/=) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
ns, String
s <- [String]
ns]
            where ns :: [String]
ns = forall a. Flag a -> [String]
flagNames 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 forall a. [a] -> [a] -> [a]
++ forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Flag_ -> Names
fromFlagShort [String] -> Flag_ -> Flag_
toFlag (forall a. (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
namesOn Flag_ -> Names
fromFlagLong [String] -> Flag_ -> Flag_
toFlag [Flag_]
flgs)}
            where ([Flag_]
flgs,[Flag_]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Flag_ -> Bool
isFlag_ 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' else Char -> Char
toLower Char
x) forall a b. (a -> b) -> a -> b
$ if forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'_' then 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad = forall {a}. String -> String -> a
err String
"repeated names" forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
bad
    where bad :: [String]
bad = forall a. Eq a => [a] -> [a]
duplicates forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Names -> [String]
have [Names]
xs

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


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


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