    {-# 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 :: 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 = 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. 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)]
    -> [(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 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 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 = 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 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=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 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 b a. (b -> a -> b) -> b -> [a] -> b
    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 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) 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 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 String -> [Flag_] -> [Flag_]
    f Maybe String
    grp [] = []
            f Maybe String
    grp (x :: Flag_
    x@Flag_{}:[Flag_]
    xs) = Flag_
    x{flagGroup=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 a. Maybe a -> Maybe a -> Maybe a
    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 = [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 :: [String]
    com = ([String] -> String) -> [[String]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map [String] -> String
    forall a. HasCallStack => [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 a. [a] -> 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 a. [a] -> 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 :: forall a. 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 = 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] -> [(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 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] -> [(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 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 String
    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 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=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
    $ 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 = Just $ unlines 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 = 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
    [String]
    Maybe String
    Maybe [String]
    builtinNames :: [String]
    builtinExplicit :: Bool
    builtinHelp :: Maybe String
    builtinGroup :: Maybe String
    builtinSummary :: Maybe [String]
    builtinNames :: Builtin_ -> [String]
    builtinExplicit :: Builtin_ -> Bool
    builtinHelp :: Builtin_ -> Maybe String
    builtinGroup :: Builtin_ -> Maybe String
    builtinSummary :: Builtin_ -> Maybe [String]
    ..}) 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 = (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 = fmap (mapModes0 f (pre ++ head (modeNames m) ++ " ")) $ modeGroupModes 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=Just $ showText txt $ msg 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 = map (pre++) $ modeNames 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 = groupCommonHide $ modeGroupFlags 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 = 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 -> [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. HasCallStack => [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 = 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 = [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 = (modeMode x){modeNames=["["++head xs++"]" | modeDefault x] ++ 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 a. [a] -> 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 = (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 :: 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. HasCallStack => [a] -> a
    last String
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' then String -> String
    forall a. HasCallStack => [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 a. [a] -> 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 a. [a] -> 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 :: 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) -> ([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