    {-# LANGUAGE RecordWildCards #-}
    module System.Console.CmdArgs.Explicit.Process(process) where

    import System.Console.CmdArgs.Explicit.Type
    import Control.Arrow
    import Data.List
    import Data.Maybe

    -- | Process a list of flags (usually obtained from @getArgs@/@expandArgsAt@) with a mode. Returns
    --   @Left@ and an error message if the command line fails to parse, or @Right@ and
    --   the associated value.
    process :: Mode a -> [String] -> Either String a
    process :: forall a. Mode a -> [String] -> Either String a
    process = Mode a -> [String] -> Either String a
    forall a. Mode a -> [String] -> Either String a
    processMode

    processMode :: Mode a -> [String] -> Either String a
    processMode :: forall a. Mode a -> [String] -> Either String a
    processMode Mode a
    m [String]
    args =
        case LookupName (Mode a)
    find of
            Ambiguous [String]
    xs -> String -> Either String a
    forall a b. a -> Either a b
    Left (String -> Either String a) -> String -> Either String a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> [String] -> String
    ambiguous String
    "mode" String
    a [String]
    xs
            Found Mode a
    x -> Mode a -> [String] -> Either String a
    forall a. Mode a -> [String] -> Either String a
    processMode Mode a
    x [String]
    as
            LookupName (Mode a)
    NotFound
                | [Arg a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (([Arg a], Maybe (Arg a)) -> [Arg a]
    forall a b. (a, b) -> a
    fst (([Arg a], Maybe (Arg a)) -> [Arg a])
    -> ([Arg a], Maybe (Arg a)) -> [Arg a]
    forall a b. (a -> b) -> a -> b
    $ Mode a -> ([Arg a], Maybe (Arg a))
    forall a. Mode a -> ([Arg a], Maybe (Arg a))
    modeArgs Mode a
    m) Bool -> Bool -> Bool
    && Maybe (Arg a) -> Bool
    forall a. Maybe a -> Bool
    isNothing (([Arg a], Maybe (Arg a)) -> Maybe (Arg a)
    forall a b. (a, b) -> b
    snd (([Arg a], Maybe (Arg a)) -> Maybe (Arg a))
    -> ([Arg a], Maybe (Arg a)) -> Maybe (Arg a)
    forall a b. (a -> b) -> a -> b
    $ Mode a -> ([Arg a], Maybe (Arg a))
    forall a. Mode a -> ([Arg a], Maybe (Arg a))
    modeArgs Mode a
    m) Bool -> Bool -> Bool
    && [String]
    args [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    &&
                  Bool -> Bool
    not ([Mode a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Mode a] -> Bool) -> [Mode a] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Mode a -> [Mode a]
    forall a. Mode a -> [Mode a]
    modeModes Mode a
    m) Bool -> Bool -> Bool
    && Bool -> Bool
    not (String
    "-" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    args)
                    -> String -> Either String a
    forall a b. a -> Either a b
    Left (String -> Either String a) -> String -> Either String a
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    missing String
    "mode" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Mode a -> [String]) -> [Mode a] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Mode a -> [String]
    forall a. Mode a -> [String]
    modeNames ([Mode a] -> [String]) -> [Mode a] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Mode a -> [Mode a]
    forall a. Mode a -> [Mode a]
    modeModes Mode a
    m
                | Bool
    otherwise -> Mode a -> a -> Either String a
    forall a. Mode a -> a -> Either String a
    modeCheck Mode a
    m (a -> Either String a) -> Either String a -> Either String a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Mode a -> a -> [String] -> Either String a
    forall a. Mode a -> a -> [String] -> Either String a
    processFlags Mode a
    m (Mode a -> a
    forall a. Mode a -> a
    modeValue Mode a
    m) [String]
    args
        where
            (LookupName (Mode a)
    find,String
    a,[String]
    as) = case [String]
    args of
                [] -> (LookupName (Mode a)
    forall a. LookupName a
    NotFound,String
    "",[])
                String
    x:[String]
    xs -> ([([String], Mode a)] -> String -> LookupName (Mode a)
    forall a. [([String], a)] -> String -> LookupName a
    lookupName ((Mode a -> ([String], Mode a)) -> [Mode a] -> [([String], Mode a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Mode a -> [String]
    forall a. Mode a -> [String]
    modeNames (Mode a -> [String])
    -> (Mode a -> Mode a) -> Mode a -> ([String], Mode a)
    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 a -> Mode a
    forall a. a -> a
    id) ([Mode a] -> [([String], Mode a)])
    -> [Mode a] -> [([String], Mode a)]
    forall a b. (a -> b) -> a -> b
    $ Mode a -> [Mode a]
    forall a. Mode a -> [Mode a]
    modeModes Mode a
    m) String
    x, String
    x, [String]
    xs)

    data S a = S
        {forall a. S a -> a
    val :: a -- The value you are accumulating
        ,forall a. S a -> [String]
    args :: [String] -- The arguments you are processing through
        ,forall a. S a -> Int
    argsCount :: Int -- The number of unnamed arguments you have seen
        ,forall a. S a -> [String]
    errs :: [String] -- The errors you have seen
        }

    stop :: Mode a -> S a -> Maybe (Either String a)
    stop :: forall a. Mode a -> S a -> Maybe (Either String a)
    stop Mode a
    mode S{a
    Int
    [String]
    val :: forall a. S a -> a
    args :: forall a. S a -> [String]
    argsCount :: forall a. S a -> Int
    errs :: forall a. S a -> [String]
    val :: a
    args :: [String]
    argsCount :: Int
    errs :: [String]
    ..}
        | 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]
    errs = Either String a -> Maybe (Either String a)
    forall a. a -> Maybe a
    Just (Either String a -> Maybe (Either String a))
    -> Either String a -> Maybe (Either String a)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String a
    forall a b. a -> Either a b
    Left (String -> Either String a) -> String -> Either String a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. HasCallStack => [a] -> a
    last [String]
    errs
        | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args = Either String a -> Maybe (Either String a)
    forall a. a -> Maybe a
    Just (Either String a -> Maybe (Either String a))
    -> Either String a -> Maybe (Either String a)
    forall a b. (a -> b) -> a -> b
    $ if Int
    argsCount Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    mn then a -> Either String a
    forall a b. b -> Either a b
    Right a
    val else
            String -> Either String a
    forall a b. a -> Either a b
    Left (String -> Either String a) -> String -> Either String a
    forall a b. (a -> b) -> a -> b
    $ String
    "Expected " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    mn Maybe Int -> Maybe Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Int
    mx then String
    "exactly" else String
    "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
    " unnamed arguments, but got only " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    argsCount
        | Bool
    otherwise = Maybe (Either String a)
    forall a. Maybe a
    Nothing
        where (Int
    mn, Maybe Int
    mx) = Mode a -> (Int, Maybe Int)
    forall a. Mode a -> (Int, Maybe Int)
    argsRange Mode a
    mode

    err :: S a -> String -> S a
    err :: forall a. S a -> String -> S a
    err S a
    s String
    x = S a
    s{errs=x:errs s}

    upd :: S a -> (a -> Either String a) -> S a
    upd :: forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s a -> Either String a
    f = case a -> Either String a
    f (a -> Either String a) -> a -> Either String a
    forall a b. (a -> b) -> a -> b
    $ S a -> a
    forall a. S a -> a
    val S a
    s of
        Left String
    x -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s String
    x
        Right a
    x -> S a
    s{val=x}

    processFlags :: Mode a -> a -> [String] -> Either String a
    processFlags :: forall a. Mode a -> a -> [String] -> Either String a
    processFlags Mode a
    mode a
    val_ [String]
    args_ = S a -> Either String a
    f (S a -> Either String a) -> S a -> Either String a
    forall a b. (a -> b) -> a -> b
    $ a -> [String] -> Int -> [String] -> S a
    forall a. a -> [String] -> Int -> [String] -> S a
    S a
    val_ [String]
    args_ Int
    0 []
        where f :: S a -> Either String a
    f S a
    s = Either String a -> Maybe (Either String a) -> Either String a
    forall a. a -> Maybe a -> a
    fromMaybe (S a -> Either String a
    f (S a -> Either String a) -> S a -> Either String a
    forall a b. (a -> b) -> a -> b
    $ Mode a -> S a -> S a
    forall a. Mode a -> S a -> S a
    processFlag Mode a
    mode S a
    s) (Maybe (Either String a) -> Either String a)
    -> Maybe (Either String a) -> Either String a
    forall a b. (a -> b) -> a -> b
    $ Mode a -> S a -> Maybe (Either String a)
    forall a. Mode a -> S a -> Maybe (Either String a)
    stop Mode a
    mode S a
    s

    pickFlags :: Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
    pickFlags Bool
    long Mode a
    mode = [((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\String
    x -> (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    long) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Flag a -> [String]
    forall a. Flag a -> [String]
    flagNames Flag a
    flag,(Flag a -> FlagInfo
    forall a. Flag a -> FlagInfo
    flagInfo Flag a
    flag,Flag a
    flag)) | Flag a
    flag <- Mode a -> [Flag a]
    forall a. Mode a -> [Flag a]
    modeFlags Mode a
    mode]

    processFlag :: Mode a -> S a -> S a
    processFlag :: forall a. Mode a -> S a -> S a
    processFlag Mode a
    mode s_ :: S a
    s_@S{args :: forall a. S a -> [String]
    args=(Char
    '-':Char
    '-':String
    xs):[String]
    ys} | String
    xs String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "" =
        case [([String], (FlagInfo, Flag a))]
    -> String -> LookupName (FlagInfo, Flag a)
    forall a. [([String], a)] -> String -> LookupName a
    lookupName (Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
    forall {a}. Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
    pickFlags Bool
    True Mode a
    mode) String
    a of
            Ambiguous [String]
    poss -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> [String] -> String
    ambiguous String
    "flag" (String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a) [String]
    poss
            LookupName (FlagInfo, Flag a)
    NotFound -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unknown flag: --" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a
            Found (FlagInfo
    arg,Flag a
    flag) -> case FlagInfo
    arg of
                FlagInfo
    FlagNone | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    b -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag String
    ""
                         | Bool
    otherwise -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unhandled argument to flag, none expected: --" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
                FlagInfo
    FlagReq | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    b Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ys -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Flag requires argument: --" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
                        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    b -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s{args=tail ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    ys
                        | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    b
                FlagInfo
    _ | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    b -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ FlagInfo -> String
    fromFlagOpt FlagInfo
    arg
                  | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    b
        where
            s :: S a
    s = S a
    s_{args=ys}
            (String
    a,String
    b) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') String
    xs

    processFlag Mode a
    mode s_ :: S a
    s_@S{args :: forall a. S a -> [String]
    args=(Char
    '-':Char
    x:String
    xs):[String]
    ys} | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '-' =
        case [([String], (FlagInfo, Flag a))]
    -> String -> LookupName (FlagInfo, Flag a)
    forall a. [([String], a)] -> String -> LookupName a
    lookupName (Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
    forall {a}. Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
    pickFlags Bool
    False Mode a
    mode) [Char
    x] of
            Ambiguous [String]
    poss -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> [String] -> String
    ambiguous String
    "flag" [Char
    '-',Char
    x] [String]
    poss
            LookupName (FlagInfo, Flag a)
    NotFound -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unknown flag: -" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x]
            Found (FlagInfo
    arg,Flag a
    flag) -> case FlagInfo
    arg of
                FlagInfo
    FlagNone | String
    "=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    xs -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unhandled argument to flag, none expected: -" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x]
                         | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=['-':xs|xs/=""] ++ ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag String
    ""
                FlagInfo
    FlagReq | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    xs Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ys -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Flag requires argument: -" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x]
                        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    xs -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=tail ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    ys
                        | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ if String
    "=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    xs then String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    xs else String
    xs
                FlagOpt String
    x | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    xs -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag String
    x
                          | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ if String
    "=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    xs then String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    xs else String
    xs
                FlagOptRare String
    x | String
    "=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    xs -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag Update a -> Update a
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    xs
                              | Bool
    otherwise -> S a -> (a -> Either String a) -> S a
    forall a. S a -> (a -> Either String a) -> S a
    upd S a
    s_{args=['-':xs|xs/=""] ++ ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
    forall a b. (a -> b) -> a -> b
    $ Flag a -> Update a
    forall a. Flag a -> Update a
    flagValue Flag a
    flag String
    x
        where
            s :: S a
    s = S a
    s_{args=ys}

    processFlag Mode a
    mode s_ :: S a
    s_@S{args :: forall a. S a -> [String]
    args=String
    "--":[String]
    ys} = S a -> S a
    f S a
    s_{args=ys}
        where f :: S a -> S a
    f S a
    s | Maybe (Either String a) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (Either String a) -> Bool)
    -> Maybe (Either String a) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Mode a -> S a -> Maybe (Either String a)
    forall a. Mode a -> S a -> Maybe (Either String a)
    stop Mode a
    mode S a
    s = S a
    s
                  | Bool
    otherwise = S a -> S a
    f (S a -> S a) -> S a -> S a
    forall a b. (a -> b) -> a -> b
    $ Mode a -> S a -> S a
    forall a. Mode a -> S a -> S a
    processArg Mode a
    mode S a
    s

    processFlag Mode a
    mode S a
    s = Mode a -> S a -> S a
    forall a. Mode a -> S a -> S a
    processArg Mode a
    mode S a
    s

    processArg :: Mode a -> S a -> S a
    processArg Mode a
    mode s_ :: S a
    s_@S{args :: forall a. S a -> [String]
    args=String
    x:[String]
    ys, argsCount :: forall a. S a -> Int
    argsCount=Int
    count} = case Mode a -> Int -> Maybe (Arg a)
    forall a. Mode a -> Int -> Maybe (Arg a)
    argsPick Mode a
    mode Int
    count of
        Maybe (Arg a)
    Nothing -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unhandled argument, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " expected: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x
            where str :: String
    str = if Int
    count Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then String
    "none" else String
    "at most " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    count
        Just Arg a
    arg -> case Arg a -> Update a
    forall a. Arg a -> Update a
    argValue Arg a
    arg String
    x (S a -> a
    forall a. S a -> a
    val S a
    s) of
                Left String
    e -> S a -> String -> S a
    forall a. S a -> String -> S a
    err S a
    s (String -> S a) -> String -> S a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unhandled argument, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x
                Right a
    v -> S a
    s{val=v}
        where
            s :: S a
    s = S a
    s_{args=ys, argsCount=count+1}

    -- find the minimum and maximum allowed number of arguments (Nothing=infinite)
    argsRange :: Mode a -> (Int, Maybe Int)
    argsRange :: forall a. Mode a -> (Int, Maybe Int)
    argsRange Mode{modeArgs :: forall a. Mode a -> ([Arg a], Maybe (Arg a))
    modeArgs=([Arg a]
    lst,Maybe (Arg a)
    end)} = (Int
    mn,Maybe Int
    mx)
        where mn :: Int
    mn = [Arg a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Arg a] -> Int) -> [Arg a] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Arg a -> Bool) -> [Arg a] -> [Arg a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Arg a -> Bool) -> Arg a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg a -> Bool
    forall a. Arg a -> Bool
    argRequire) ([Arg a] -> [Arg a]) -> [Arg a] -> [Arg a]
    forall a b. (a -> b) -> a -> b
    $ [Arg a] -> [Arg a]
    forall a. [a] -> [a]
    reverse ([Arg a] -> [Arg a]) -> [Arg a] -> [Arg a]
    forall a b. (a -> b) -> a -> b
    $ [Arg a]
    lst [Arg a] -> [Arg a] -> [Arg a]
    forall a. [a] -> [a] -> [a]
    ++ Maybe (Arg a) -> [Arg a]
    forall a. Maybe a -> [a]
    maybeToList Maybe (Arg a)
    end
              mx :: Maybe Int
    mx = if Maybe (Arg a) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Arg a)
    end then Maybe Int
    forall a. Maybe a
    Nothing else Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ [Arg a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Arg a]
    lst

    argsPick :: Mode a -> Int -> Maybe (Arg a)
    argsPick :: forall a. Mode a -> Int -> Maybe (Arg a)
    argsPick Mode{modeArgs :: forall a. Mode a -> ([Arg a], Maybe (Arg a))
    modeArgs=([Arg a]
    lst,Maybe (Arg a)
    end)} Int
    i = if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Arg a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Arg a]
    lst then Arg a -> Maybe (Arg a)
    forall a. a -> Maybe a
    Just (Arg a -> Maybe (Arg a)) -> Arg a -> Maybe (Arg a)
    forall a b. (a -> b) -> a -> b
    $ [Arg a]
    lst [Arg a] -> Int -> Arg a
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i else Maybe (Arg a)
    end

    ---------------------------------------------------------------------
    -- UTILITIES

    ambiguous :: String -> String -> [String] -> String
    ambiguous String
    typ String
    got [String]
    xs = String
    "Ambiguous " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typ String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    got String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "', could be any of: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    xs
    missing :: String -> [String] -> String
    missing String
    typ [String]
    xs = String
    "Missing " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typ String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", wanted any of: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    xs

    data LookupName a = NotFound
                      | Ambiguous [Name]
                      | Found a

    -- different order to lookup so can potentially partially-apply it
    lookupName :: [([Name],a)] -> Name -> LookupName a
    lookupName :: forall a. [([String], a)] -> String -> LookupName a
    lookupName [([String], a)]
    names String
    value =
        case ((String -> String -> Bool) -> [(String, a)]
    match String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    (==), (String -> String -> Bool) -> [(String, a)]
    match String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf) of
            ([],[]) -> LookupName a
    forall a. LookupName a
    NotFound
            ([],[(String, a)
    x]) -> a -> LookupName a
    forall a. a -> LookupName a
    Found (a -> LookupName a) -> a -> LookupName a
    forall a b. (a -> b) -> a -> b
    $ (String, a) -> a
    forall a b. (a, b) -> b
    snd (String, a)
    x
            ([],[(String, a)]
    xs) -> [String] -> LookupName a
    forall a. [String] -> LookupName a
    Ambiguous ([String] -> LookupName a) -> [String] -> LookupName a
    forall a b. (a -> b) -> a -> b
    $ ((String, a) -> String) -> [(String, a)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, a) -> String
    forall a b. (a, b) -> a
    fst [(String, a)]
    xs
            ([(String, a)
    x],[(String, a)]
    _) -> a -> LookupName a
    forall a. a -> LookupName a
    Found (a -> LookupName a) -> a -> LookupName a
    forall a b. (a -> b) -> a -> b
    $ (String, a) -> a
    forall a b. (a, b) -> b
    snd (String, a)
    x
            ([(String, a)]
    xs,[(String, a)]
    _) -> [String] -> LookupName a
    forall a. [String] -> LookupName a
    Ambiguous ([String] -> LookupName a) -> [String] -> LookupName a
    forall a b. (a -> b) -> a -> b
    $ ((String, a) -> String) -> [(String, a)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, a) -> String
    forall a b. (a, b) -> a
    fst [(String, a)]
    xs
        where
            match :: (String -> String -> Bool) -> [(String, a)]
    match String -> String -> Bool
    op = [([String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    ys,a
    v) | ([String]
    xs,a
    v) <- [([String], a)]
    names, let ys :: [String]
    ys = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    op String
    value) [String]
    xs, [String]
    ys [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []]