{-# 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 [[Char]])
-> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall a. (a -> Maybe [[Char]]) -> Mode a -> Mode a
setReform (Prog_ -> CmdArgs Any -> Maybe [[Char]]
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 :: forall a. Prog_ -> Mode a -> Mode a
setProgOpts Prog_
p Mode a
m = Mode a
m{modeExpandAt = not $ progNoAtExpand p
                   ,modeGroupModes = fmap (setProgOpts p) $ modeGroupModes 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 a. [a] -> 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. HasCallStack => [a] -> a
head [(Mode_, Mode (CmdArgs Any))]
ms){modeNames=[progProgram x]}
           | [Mode (CmdArgs Any)] -> Int
forall a. [a] -> 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 = [Char] -> [Char] -> Mode (CmdArgs Any)
forall {b}. [Char] -> [Char] -> b
err [Char]
"prog" [Char]
"Multiple automatic modes"
           | Bool
otherwise = ([Mode (CmdArgs Any)] -> Mode (CmdArgs Any)
forall a. HasCallStack => [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=[progProgram x], modeGroupModes=grouped, modeHelp=progHelp x}
    where
        grouped :: Group (Mode (CmdArgs Any))
grouped = [Mode (CmdArgs Any)]
-> [Mode (CmdArgs Any)]
-> [([Char], [Mode (CmdArgs Any)])]
-> Group (Mode (CmdArgs Any))
forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group (Maybe [Char] -> [Mode (CmdArgs Any)]
pick Maybe [Char]
forall a. Maybe a
Nothing) [] [([Char]
g, Maybe [Char] -> [Mode (CmdArgs Any)]
pick (Maybe [Char] -> [Mode (CmdArgs Any)])
-> Maybe [Char] -> [Mode (CmdArgs Any)]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
g) | [Char]
g <- [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ((Mode_, Mode (CmdArgs Any)) -> Maybe [Char])
-> [(Mode_, Mode (CmdArgs Any))] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Mode_ -> Maybe [Char]
modeGroup (Mode_ -> Maybe [Char])
-> ((Mode_, Mode (CmdArgs Any)) -> Mode_)
-> (Mode_, Mode (CmdArgs Any))
-> Maybe [Char]
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 [Char] -> [Mode (CmdArgs Any)]
pick Maybe [Char]
x = [Mode (CmdArgs Any)
m | (Mode_
m_,Mode (CmdArgs Any)
m) <- [(Mode_, Mode (CmdArgs Any))]
ms, Mode_ -> Maybe [Char]
modeGroup Mode_
m_ Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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
x -> if CmdArgs Any -> Bool
forall a. CmdArgs a -> Bool
cmdArgsHasValue CmdArgs Any
x then [Char] -> Either [Char] (CmdArgs Any)
forall a b. a -> Either a b
Left [Char]
"No mode given and no default mode" else CmdArgs Any -> Either [Char] (CmdArgs Any)
forall a b. b -> Either a b
Right CmdArgs Any
x
    ,modeGroupFlags = groupUncommonDelete $ modeGroupFlags x
    ,modeArgs=([],Nothing), 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 = groupUncommonHide $ modeGroupFlags x
    ,modeArgs = let zeroArg Arg a
x = Arg a
x{argType=""} in map zeroArg *** fmap zeroArg $ modeArgs x
    ,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 = either Left (Right . fmap fix) . modeCheck m}
    where fix :: Any -> Any
fix Any
a = ((Any -> Any) -> Any -> Any) -> Any -> [Any -> Any] -> Any
forall a b. (a -> b -> b) -> b -> [a] -> b
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 (pick Nothing) [] [(g, pick $ Just g) | g <- groups]}
    where
        pick :: Maybe [Char] -> [Flag (CmdArgs Any)]
pick Maybe [Char]
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 [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe [Char]
x (Maybe [Char] -> Bool) -> (Flag_ -> Maybe [Char]) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe [Char]
flagGroup) [Flag_]
xs
        groups :: [[Char]]
groups = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Flag_ -> Maybe [Char]) -> [Flag_] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Flag_ -> Maybe [Char]
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=chk, modeArgs = ([], Just $ flagArg upd 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 a. [a] -> 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 [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool) -> (Flag_ -> Maybe [Char]) -> Flag_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Maybe [Char]
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 [Char] (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 [Char] (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 = [Char] -> Either [Char] (CmdArgs Any)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (CmdArgs Any))
-> [Char] -> Either [Char] (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ [Char]
"Requires at least " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
mn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" arguments, got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
              | Bool
otherwise = (Either [Char] (CmdArgs Any)
 -> Flag_ -> Either [Char] (CmdArgs Any))
-> Either [Char] (CmdArgs Any)
-> [Flag_]
-> Either [Char] (CmdArgs Any)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either [Char] (CmdArgs Any) -> Flag_ -> Either [Char] (CmdArgs Any)
f (Int -> CmdArgs Any -> Either [Char] (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 [Char] (CmdArgs Any) -> Flag_ -> Either [Char] (CmdArgs Any)
f (Right CmdArgs Any
v) Flag_
arg = Flag_ -> Update (CmdArgs Any)
argUpd Flag_
arg (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Flag_ -> Maybe [Char]
flagArgOpt Flag_
arg) CmdArgs Any
v
                  f Either [Char] (CmdArgs Any)
x Flag_
_ = Either [Char] (CmdArgs Any)
x

        -- if we have repeating args which is also opt, translate that here
        addOptArgs :: Int -> CmdArgs Any -> Either [Char] (CmdArgs Any)
addOptArgs Int
n CmdArgs Any
v
            | Just Flag_
x <- Maybe Flag_
rep, Just [Char]
o <- Flag_ -> Maybe [Char]
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 [Char]
o CmdArgs Any
v
            | Bool
otherwise = CmdArgs Any -> Either [Char] (CmdArgs Any)
forall a b. b -> Either a b
Right CmdArgs Any
v

        hlp :: [Char]
hlp = [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
x -> [Char]
"["[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
x[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"]") [[Char]]
b
            where ([[Char]]
a,[[Char]]
b) = Int -> [[Char]] -> ([[Char]], [[Char]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
mn ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]] -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ (Flag_ -> [Char]) -> [Flag_] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Arg (CmdArgs Any) -> [Char]
forall a. Arg a -> [Char]
argType (Arg (CmdArgs Any) -> [Char])
-> (Flag_ -> Arg (CmdArgs Any)) -> Flag_ -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag_ -> Arg (CmdArgs Any)
flagArg_) ([Flag_] -> [[Char]]) -> [Flag_] -> [[Char]]
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 [Char]
s CmdArgs Any
v | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Flag_] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flag_]
ord = Flag_ -> Update (CmdArgs Any)
argUpd ([Flag_]
ord [Flag_] -> Int -> Flag_
forall a. HasCallStack => [a] -> Int -> a
!! Int
n) [Char]
s CmdArgs Any
v2
                | Just Flag_
x <- Maybe Flag_
rep = Flag_ -> Update (CmdArgs Any)
argUpd Flag_
x [Char]
s CmdArgs Any
v2
                | Bool
otherwise = [Char] -> Either [Char] (CmdArgs Any)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (CmdArgs Any))
-> [Char] -> Either [Char] (CmdArgs Any)
forall a b. (a -> b) -> a -> b
$ [Char]
"expected at most " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Flag_] -> Int
forall a. [a] -> 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 = map (\Mode_
m -> Mode_
m{modeFlags_ = f Nothing $ modeFlags_ m}) $ progModes p}
    where
        f :: Maybe [Char] -> [Flag_] -> [Flag_]
f Maybe [Char]
grp [] = []
        f Maybe [Char]
grp (x :: Flag_
x@Flag_{}:[Flag_]
xs) = Flag_
x{flagGroup=grp2} Flag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
: Maybe [Char] -> [Flag_] -> [Flag_]
f Maybe [Char]
grp2 [Flag_]
xs
            where grp2 :: Maybe [Char]
grp2 = Flag_ -> Maybe [Char]
flagGroup Flag_
x Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe [Char]
grp
        f Maybe [Char]
grp (Flag_
x:[Flag_]
xs) = Flag_
x Flag_ -> [Flag_] -> [Flag_]
forall a. a -> [a] -> [a]
: Maybe [Char] -> [Flag_] -> [Flag_]
f Maybe [Char]
grp [Flag_]
xs


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


commonGroup :: [Char]
commonGroup = [Char]
"Common flags"

groupSplitCommon :: Group a -> ([a], Group a)
groupSplitCommon :: forall a. Group a -> ([a], Group a)
groupSplitCommon (Group [a]
unnamed [a]
hidden [([Char], [a])]
named) = ((([Char], [a]) -> [a]) -> [([Char], [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [a]) -> [a]
forall a b. (a, b) -> b
snd [([Char], [a])]
com, [a] -> [a] -> [([Char], [a])] -> Group a
forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group [a]
unnamed [a]
hidden [([Char], [a])]
uni)
    where ([([Char], [a])]
com,[([Char], [a])]
uni) = (([Char], [a]) -> Bool)
-> [([Char], [a])] -> ([([Char], [a])], [([Char], [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Char]
commonGroup ([Char] -> Bool)
-> (([Char], [a]) -> [Char]) -> ([Char], [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [a]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [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 = groupHidden b ++ 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] -> [([Char], [a])] -> Group a
forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group [] (Group a -> [a]
forall a. Group a -> [a]
fromGroup Group a
b) [([Char]
commonGroup,[a]
a) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall a. [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] -> [([Char], [a])] -> Group a
forall a. [a] -> [a] -> [([Char], [a])] -> Group a
Group [] [] [([Char]
commonGroup,[a]
a) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall a. [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 = map f $ progModes p}
    where f :: Mode_ -> Mode_
f Mode_
m = Mode_
m{modeFlags_ = modeFlags_ m ++ flags}
          grp :: Maybe [Char]
grp = if [Mode_] -> Int
forall a. [a] -> 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 [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
commonGroup else Maybe [Char]
forall a. Maybe a
Nothing
          wrap :: Flag (CmdArgs Any) -> Flag_
wrap Flag (CmdArgs Any)
x = Flag_
forall a. Default a => a
def{flagFlag=x, flagExplicit=True, flagGroup=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
$ [Char] -> HelpFormat -> TextFormat -> CmdArgs Any -> CmdArgs Any
forall a. HasCallStack => [Char] -> a
error [Char]
"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 = Just $ unlines v}
                        | Just [[Char]]
v <- [Prog_ -> Maybe [[Char]]
forall {m :: * -> *}. Monad m => Prog_ -> Maybe (m [Char])
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 = Just $ unlines $ progVersionOutput p}
          verb :: Verbosity -> CmdArgs a -> CmdArgs a
verb Verbosity
v CmdArgs a
x = CmdArgs a
x{cmdArgsVerbosity = Just 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
[[Char]]
Maybe [Char]
Maybe [[Char]]
builtinNames :: [[Char]]
builtinExplicit :: Bool
builtinHelp :: Maybe [Char]
builtinGroup :: Maybe [Char]
builtinSummary :: Maybe [[Char]]
builtinSummary :: Builtin_ -> Maybe [[Char]]
builtinGroup :: Builtin_ -> Maybe [Char]
builtinHelp :: Builtin_ -> Maybe [Char]
builtinExplicit :: Builtin_ -> Bool
builtinNames :: Builtin_ -> [[Char]]
..}) Flag a
x = [Flag a
x
    {flagNames = builtinNames ++ if builtinExplicit then [] else flagNames x
    ,flagHelp = fromMaybe (flagHelp x) 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=y, flagGroup = builtinGroup b `mplus` flagGroup 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 = ([Char] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any))
-> [Char] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall {a}.
([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
mapModes0 [Char] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
forall {a}. [Char] -> Mode (CmdArgs a) -> Mode (CmdArgs a)
add [Char]
""
    where
        mapModes0 :: ([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
mapModes0 [Char] -> Mode a -> Mode a
f [Char]
pre Mode a
m = [Char] -> Mode a -> Mode a
f [Char]
pre (Mode a -> Mode a) -> Mode a -> Mode a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
mapModes1 [Char] -> Mode a -> Mode a
f [Char]
pre Mode a
m
        mapModes1 :: ([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
mapModes1 [Char] -> Mode a -> Mode a
f [Char]
pre Mode a
m = Mode a
m{modeGroupModes = fmap (mapModes0 f (pre ++ head (modeNames m) ++ " ")) $ modeGroupModes m}

        add :: [Char] -> Mode (CmdArgs a) -> Mode (CmdArgs a)
add [Char]
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=Just $ showText txt $ msg hlp}
            where msg :: HelpFormat -> [Text]
msg HelpFormat
hlp = [[Char]] -> HelpFormat -> Mode (CmdArgs a) -> [Text]
forall a. [[Char]] -> HelpFormat -> Mode a -> [Text]
helpText (Prog_ -> [[Char]]
progHelpOutput Prog_
p) HelpFormat
hlp (Mode (CmdArgs a) -> Mode (CmdArgs a)
forall {a}. Mode a -> Mode a
prepare Mode (CmdArgs a)
m{modeNames = map (pre++) $ modeNames m})

        prepare :: Mode a -> Mode a
prepare = ([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
forall {a}.
([Char] -> Mode a -> Mode a) -> [Char] -> Mode a -> Mode a
mapModes1 (\[Char]
_ Mode a
m -> Mode a
m{modeGroupFlags = groupCommonHide $ modeGroupFlags m}) [Char]
""


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 = fmap f $ modeGroupFlags 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 -> [[Char]]) -> [Flag a] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag a -> [[Char]]
forall a. Flag a -> [[Char]]
flagNames [Flag a]
hlp [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== Flag a -> [[Char]]
forall a. Flag a -> [[Char]]
flagNames Flag a
flg then [Flag a] -> Flag a
forall a. HasCallStack => [a] -> a
head [Flag a]
hlp else Flag a
flg


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


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

assignNames :: Prog_ -> Prog_
assignNames :: Prog_ -> Prog_
assignNames Prog_
x = Prog_
x{progModes = map f $ namesOn fromMode toMode $ progModes x}
    where
        fromMode :: Mode_ -> Names
fromMode Mode_
x = [[Char]] -> [[Char]] -> Names
Names (Mode (CmdArgs Any) -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames (Mode (CmdArgs Any) -> [[Char]]) -> Mode (CmdArgs Any) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x) [[Char] -> [Char]
asName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Any -> [Char]
ctor (Any -> [Char]) -> Any -> [Char]
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 :: [[Char]] -> Mode_ -> Mode_
toMode [[Char]]
xs Mode_
x = Mode_
x{modeMode = (modeMode x){modeNames=["["++head xs++"]" | modeDefault x] ++ xs}}

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

        f :: Mode_ -> Mode_
f Mode_
x = Mode_
x{modeFlags_ = rest ++ namesOn fromFlagShort toFlag (namesOn fromFlagLong toFlag 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 :: [Char] -> [Char]
asName [Char]
s = (Char -> Char) -> [Char] -> [Char]
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) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ if [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
s else [Char]
s

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

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

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


duplicates :: Eq a => [a] -> [a]
duplicates :: forall a. Eq a => [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 :: forall a. (a -> Names) -> ([[Char]] -> a -> a) -> [a] -> [a]
namesOn a -> Names
f [[Char]] -> a -> a
g [a]
xs = ([[Char]] -> a -> a) -> [[[Char]]] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [[Char]] -> a -> a
g ([Names] -> [[[Char]]]
names ([Names] -> [[[Char]]]) -> [Names] -> [[[Char]]]
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