    {-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-}
    #if __GLASGOW_HASKELL__ > 720
    {-# LANGUAGE Safe #-}
    #endif
    ------------------------------------------------------------
    -- |
    -- Module      :  System.Console.ParseArgs
    -- Description :  Full-featured command-line argument parsing library.
    -- Copyright   :  (c) 2007 Bart Massey
    -- License     :  BSD-style (see the file COPYING)
    -- Maintainer  :  Bart Massey <bart.massey@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- `ParseArgs` is a full-featured command-line argument
    -- parsing library.
    --
    -- This module supplies an argument parser.  Given a
    -- description of type [`Arg`] of the legal arguments to the
    -- program, a list of argument strings, and a bit of extra
    -- information, the `parseArgs` function in this module
    -- returns an `Args` data structure suitable for querying
    -- using the provided functions `gotArg`, `getArg`, etc.
    ------------------------------------------------------------

    module System.Console.ParseArgs (
      -- * Describing allowed arguments
      -- |The argument parser requires a description of
      -- the arguments that will be parsed.  This is
      -- supplied as a list of `Arg` records, built up
      -- using the functions described here.
      Arg(..),
      Argtype(..),
      ArgsComplete(..),
      ArgsDash(..),
      APCData(..),
      ArgsParseControl(..),
      -- ** DataArg and its pseudo-constructors
      DataArg,
      argDataRequired, argDataOptional, argDataDefaulted,
      -- * Argument processing
      -- |The argument descriptions are used to parse
      -- the command line arguments, and the results
      -- of the parse can later be (efficiently) queried
      -- to determine program behavior.

      -- ** Getting parse results
      -- |The argument parser returns an opaque map
      -- from argument index to parsed argument data
      -- (plus some convenience information).
      Args(..),
      parseArgs, parseArgsIO,
      -- ** Using parse results
      -- |Query functions permit checking for the existence
      -- and values of command-line arguments.
      gotArg, ArgType(..),
      getArgString, getArgFile, getArgStdio,
      getArgInteger, getArgInt,
      getArgDouble, getArgFloat,
      ArgFileOpener(..),
      -- * Misc
      ParseArgsException(..),
      baseName, parseError, usageError,
      System.IO.IOMode(ReadMode, WriteMode, AppendMode))
    where

    import Control.Exception
    import Control.Monad
    import Control.Monad.ST
    import Data.List
    import qualified Data.Map as Map
    import Data.Maybe
    import Data.Typeable
    import System.Environment
    import System.IO

    -- The main job of this module is to provide parseArgs.
    -- See below for its contract.

    --
    -- Provided datatypes.
    --

    -- |The description of an argument, suitable for
    -- messages and for parsing.  The `argData` field
    -- is used both for flags with a data argument, and
    -- for positional data arguments.
    --
    -- There are two cases:
    --
    --     (1) The argument is a flag, in which case at least
    --     one of `argAbbr` and `argName` is provided;
    --
    --     (2) The argument is positional, in which case neither
    --     `argAbbr` nor `argName` are provided, but `argData` is.
    --
    -- If none of `argAbbr`, `argName`, or `argData` are
    -- provided, this is an error.  See also the
    -- `argDataRequired`, `argDataOptional`, and
    -- `argDataDefaulted` functions below, which are used to
    -- generate `argData`.
    data (Ord a) => Arg a =
        Arg { forall a. Ord a => Arg a -> a
    argIndex :: a              -- ^Connects the input description
                                         -- to the output argument.
            , forall a. Ord a => Arg a -> Maybe Char
    argAbbr :: Maybe Char      -- ^One-character flag name.
            , forall a. Ord a => Arg a -> Maybe String
    argName :: Maybe String    -- ^\"Long name\" of flag.
            , forall a. Ord a => Arg a -> Maybe DataArg
    argData :: Maybe DataArg   -- ^Datum description.
            , forall a. Ord a => Arg a -> String
    argDesc :: String          -- ^Documentation for the argument.
            }

    -- |The types of an argument carrying data.  The constructor
    -- argument is used to carry a default value.
    --
    -- The constructor argument should really be hidden.
    -- Values of this type are normally constructed within
    -- the pseudo-constructors pseudo-constructors
    -- `argDataRequired`, `argDataOptional`, and
    -- `argDataDefaulted`, to which only the constructor
    -- function itself is passed.
    data Argtype = ArgtypeString (Maybe String)
                 | ArgtypeInteger (Maybe Integer)
                 | ArgtypeInt (Maybe Int)
                 | ArgtypeDouble (Maybe Double)
                 | ArgtypeFloat (Maybe Float)

    -- |Information specific to an argument carrying a datum.  This
    -- is an opaque type, whose instances are constructed using the
    -- pseudo-constructors `argDataRequired`, `argDataOptional`,
    -- and `argDataDefaulted`.
    data DataArg = DataArg { DataArg -> String
    dataArgName :: String       -- ^Print name of datum.
                           , DataArg -> Argtype
    dataArgArgtype :: Argtype   -- ^Type of datum.
                           , DataArg -> Bool
    dataArgOptional :: Bool     -- ^Datum is not required.
                           }

    -- |Generate the `argData` for the given non-optional argument.
    argDataRequired :: String                 -- ^Datum print name.
                    -> (Maybe a -> Argtype)   -- ^Type constructor for datum.
                    -> Maybe DataArg          -- ^Result is `argData`-ready.
    argDataRequired :: forall a. String -> (Maybe a -> Argtype) -> Maybe DataArg
    argDataRequired String
    s Maybe a -> Argtype
    c = DataArg -> Maybe DataArg
    forall a. a -> Maybe a
    Just (DataArg { dataArgName :: String
    dataArgName = String
    s,
                                          dataArgArgtype :: Argtype
    dataArgArgtype = Maybe a -> Argtype
    c Maybe a
    forall a. Maybe a
    Nothing,
                                          dataArgOptional :: Bool
    dataArgOptional = Bool
    False })

    -- |Generate the `argData` for the given optional argument with no default.
    argDataOptional :: String                 -- ^Datum print name.
                    -> (Maybe a -> Argtype)   -- ^Type constructor for datum.
                    -> Maybe DataArg          -- ^Result is `argData`-ready.
    argDataOptional :: forall a. String -> (Maybe a -> Argtype) -> Maybe DataArg
    argDataOptional String
    s Maybe a -> Argtype
    c = DataArg -> Maybe DataArg
    forall a. a -> Maybe a
    Just (DataArg { dataArgName :: String
    dataArgName = String
    s,
                                          dataArgArgtype :: Argtype
    dataArgArgtype = Maybe a -> Argtype
    c Maybe a
    forall a. Maybe a
    Nothing,
                                          dataArgOptional :: Bool
    dataArgOptional = Bool
    True })

    -- |Generate the `argData` for the given optional argument with the
    -- given default.
    argDataDefaulted :: String                 -- ^Datum print name.
                     -> (Maybe a -> Argtype)   -- ^Type constructor for datum.
                     -> a                      -- ^Datum default value.
                     -> Maybe DataArg          -- ^Result is `argData`-ready.
    argDataDefaulted :: forall a. String -> (Maybe a -> Argtype) -> a -> Maybe DataArg
    argDataDefaulted String
    s Maybe a -> Argtype
    c a
    d = DataArg -> Maybe DataArg
    forall a. a -> Maybe a
    Just (DataArg { dataArgName :: String
    dataArgName = String
    s,
                                             dataArgArgtype :: Argtype
    dataArgArgtype = Maybe a -> Argtype
    c (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    d),
                                             dataArgOptional :: Bool
    dataArgOptional = Bool
    True })
    --
    -- Returned datatypes.
    --

    -- |The \"kinds of values\" an argument can have.
    data Argval = ArgvalFlag   -- ^For simple present vs not-present flags.
                | ArgvalString String
                | ArgvalInteger Integer
                | ArgvalInt Int
                | ArgvalDouble Double
                | ArgvalFloat Float

    -- |The type of the mapping from argument index to value.
    newtype ArgRecord a = ArgRecord (Map.Map a Argval)

    -- |The data structure `parseArgs` produces. There is a should-be-hidden
    -- field that describes the parse.
    data (Ord a) => Args a =
        Args { forall a. Ord a => Args a -> ArgRecord a
    __args :: ArgRecord a    -- ^The argument parse, only listed here
                                        -- to work around a Haddock bug. See
                                        -- <https://github.com/haskell/haddock/issues/456>.
             , forall a. Ord a => Args a -> String
    argsProgName :: String   -- ^Basename of 0th argument.
             , forall a. Ord a => Args a -> String
    argsUsage :: String      -- ^Full usage string.
             , forall a. Ord a => Args a -> [String]
    argsRest :: [ String ]   -- ^Remaining unprocessed arguments.
             }

    --
    -- Exception type.
    --

    -- |This exception is raised with an appropriate error message
    -- when argument parsing fails.  The first argument is the usage
    -- message, the second the actual error message from the parser.
    data ParseArgsException = ParseArgsException String String
         deriving (ParseArgsException -> ParseArgsException -> Bool
    (ParseArgsException -> ParseArgsException -> Bool)
    -> (ParseArgsException -> ParseArgsException -> Bool)
    -> Eq ParseArgsException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ParseArgsException -> ParseArgsException -> Bool
    == :: ParseArgsException -> ParseArgsException -> Bool
    $c/= :: ParseArgsException -> ParseArgsException -> Bool
    /= :: ParseArgsException -> ParseArgsException -> Bool
    Eq, Typeable)

    instance Exception ParseArgsException

    instance Show ParseArgsException where
        show :: ParseArgsException -> String
    show (ParseArgsException String
    usage String
    msg) = String
    msg String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    usage

    --
    -- Implementation.
    --

    -- |True if the described argument is positional.
    arg_posn :: (Ord a) =>
                Arg a   -- ^Argument.
             -> Bool    -- ^True if argument is positional.
    arg_posn :: forall a. Ord a => Arg a -> Bool
    arg_posn (Arg { argAbbr :: forall a. Ord a => Arg a -> Maybe Char
    argAbbr = Maybe Char
    Nothing,
                    argName :: forall a. Ord a => Arg a -> Maybe String
    argName = Maybe String
    Nothing }) = Bool
    True
    arg_posn Arg a
    _ = Bool
    False

    -- |True if the described argument is a flag.
    arg_flag :: (Ord a) =>
                Arg a   -- ^Argument.
             -> Bool    -- ^True if argument is a flag.
    arg_flag :: forall a. Ord a => Arg a -> Bool
    arg_flag Arg a
    a = Bool -> Bool
    not (Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_posn Arg a
    a)

    -- |True if the described argument is optional.
    arg_optional :: (Ord a) =>
                    Arg a   -- ^Argument.
                 -> Bool    -- ^False if argument is required to be present.
    arg_optional :: forall a. Ord a => Arg a -> Bool
    arg_optional (Arg { argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Just (DataArg { dataArgOptional :: DataArg -> Bool
    dataArgOptional = Bool
    b }) }) = Bool
    b
    arg_optional Arg a
    _ = Bool
    True

    arg_required :: (Ord a) =>
                    Arg a   -- ^Argument.
                 -> Bool    -- ^True if argument is required to be present.
    arg_required :: forall a. Ord a => Arg a -> Bool
    arg_required Arg a
    a = Bool -> Bool
    not (Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_optional Arg a
    a)

    -- |Return the value of a defaulted argument.
    arg_default_value :: (Ord a)
                      => Arg a         -- ^Argument.
                      -> Maybe Argval  -- ^Optional default value.
    arg_default_value :: forall a. Ord a => Arg a -> Maybe Argval
    arg_default_value arg :: Arg a
    arg@(Arg { argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Just
                                 (DataArg { dataArgArgtype :: DataArg -> Argtype
    dataArgArgtype = Argtype
    da }) }) |
                                 Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_optional Arg a
    arg =
        Argtype -> Maybe Argval
    defval Argtype
    da
        where
          defval :: Argtype -> Maybe Argval
    defval (ArgtypeString (Just String
    v)) = Argval -> Maybe Argval
    forall a. a -> Maybe a
    Just (String -> Argval
    ArgvalString String
    v)
          defval (ArgtypeInteger (Just Integer
    v)) = Argval -> Maybe Argval
    forall a. a -> Maybe a
    Just (Integer -> Argval
    ArgvalInteger Integer
    v)
          defval (ArgtypeInt (Just Int
    v)) = Argval -> Maybe Argval
    forall a. a -> Maybe a
    Just (Int -> Argval
    ArgvalInt Int
    v)
          defval (ArgtypeDouble (Just Double
    v)) = Argval -> Maybe Argval
    forall a. a -> Maybe a
    Just (Double -> Argval
    ArgvalDouble Double
    v)
          defval (ArgtypeFloat (Just Float
    v)) = Argval -> Maybe Argval
    forall a. a -> Maybe a
    Just (Float -> Argval
    ArgvalFloat Float
    v)
          defval Argtype
    _ = Maybe Argval
    forall a. Maybe a
    Nothing
    arg_default_value Arg a
    _ = Maybe Argval
    forall a. Maybe a
    Nothing

    -- |There's probably a better way to do this.
    perhaps :: Bool -> String -> String
    perhaps :: Bool -> ShowS
    perhaps Bool
    b String
    s = if Bool
    b then String
    s else String
    ""

    -- |Format the described argument as a string.
    arg_string :: (Ord a) =>
                  Arg a    -- ^Argument to be described.
               -> String   -- ^String describing argument.
    arg_string :: forall a. Ord a => Arg a -> String
    arg_string a :: Arg a
    a@(Arg { argAbbr :: forall a. Ord a => Arg a -> Maybe Char
    argAbbr = Maybe Char
    abbr,
                        argName :: forall a. Ord a => Arg a -> Maybe String
    argName = Maybe String
    name,
                        argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Maybe DataArg
    arg }) =
                   (ShowS
    optionally String
    "[") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   ((Char -> String) -> Maybe Char -> String
    forall {a}. (a -> String) -> Maybe a -> String
    sometimes Char -> String
    flag_abbr Maybe Char
    abbr) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   (Bool -> ShowS
    perhaps ((Maybe Char -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Char
    abbr) Bool -> Bool -> Bool
    && (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    name)) String
    ",") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   (ShowS -> Maybe String -> String
    forall {a}. (a -> String) -> Maybe a -> String
    sometimes ShowS
    flag_name Maybe String
    name) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   (Bool -> ShowS
    perhaps ((Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_flag Arg a
    a) Bool -> Bool -> Bool
    && (Maybe DataArg -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe DataArg
    arg)) String
    " ") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   ((DataArg -> String) -> Maybe DataArg -> String
    forall {a}. (a -> String) -> Maybe a -> String
    sometimes DataArg -> String
    data_arg Maybe DataArg
    arg) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                   (ShowS
    optionally String
    "]")
        where
          sometimes :: (a -> String) -> Maybe a -> String
    sometimes = String -> (a -> String) -> Maybe a -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    ""
          optionally :: ShowS
    optionally String
    s = Bool -> ShowS
    perhaps (Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_optional Arg a
    a) String
    s
          flag_name :: ShowS
    flag_name String
    s = String
    "--" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
          flag_abbr :: Char -> String
    flag_abbr Char
    c = [ Char
    '-', Char
    c ]
          data_arg :: DataArg -> String
    data_arg (DataArg {dataArgName :: DataArg -> String
    dataArgName = String
    s}) = String
    "<" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">"

    -- |Filter out the empty keys for a hash.
    filter_keys :: [ (Maybe a, b) ]   -- ^List of (optional key, value) pairs.
                -> [ (a, b) ]         -- ^Pairs with actual keys.
    filter_keys :: forall a b. [(Maybe a, b)] -> [(a, b)]
    filter_keys [(Maybe a, b)]
    l =
        ((Maybe a, b) -> [(a, b)] -> [(a, b)])
    -> [(a, b)] -> [(Maybe a, b)] -> [(a, b)]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Maybe a, b) -> [(a, b)] -> [(a, b)]
    forall {a} {b}. (Maybe a, b) -> [(a, b)] -> [(a, b)]
    check_key [] [(Maybe a, b)]
    l
        where
          check_key :: (Maybe a, b) -> [(a, b)] -> [(a, b)]
    check_key (Maybe a
    Nothing, b
    _) [(a, b)]
    rest = [(a, b)]
    rest
          check_key (Just a
    k, b
    v) [(a, b)]
    rest = (a
    k, b
    v) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)]
    rest

    -- |Fail with an error if the argument description is bad
    -- for some reason.
    argdesc_error :: String   -- ^Error message.
                  -> a        -- ^Bogus polymorphic result.
    argdesc_error :: forall a. String -> a
    argdesc_error String
    msg =
        String -> a
    forall a. HasCallStack => String -> a
    error (String
    "internal error: argument description: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)

    -- |Make a keymap.
    keymap_from_list :: (Ord k, Show k) =>
                        [ (k, a) ]    -- ^List of key-value pairs.
                                      -- Will be checked for duplicate keys.
                     -> Map.Map k a   -- ^Key-value map.
    keymap_from_list :: forall k a. (Ord k, Show k) => [(k, a)] -> Map k a
    keymap_from_list [(k, a)]
    l =
        (Map k a -> (k, a) -> Map k a) -> Map k a -> [(k, a)] -> Map k a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Map k a -> (k, a) -> Map k a
    forall {a} {a}. (Ord a, Show a) => Map a a -> (a, a) -> Map a a
    add_entry Map k a
    forall k a. Map k a
    Map.empty [(k, a)]
    l
        where
          add_entry :: Map a a -> (a, a) -> Map a a
    add_entry Map a a
    m (a
    k, a
    a) =
              case a -> Map a a -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member a
    k Map a a
    m of
                Bool
    False -> a -> a -> Map a a -> Map a a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert a
    k a
    a Map a a
    m
                Bool
    True -> String -> Map a a
    forall a. String -> a
    argdesc_error (String
    "duplicate argument description name " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                       (a -> String
    forall a. Show a => a -> String
    show a
    k))

    -- |Make a keymap for looking up a flag argument.
    make_keymap :: (Ord k, Show k) =>
                   (Arg a -> Maybe k)   -- ^Mapping from argdesc to flag key.
                -> [Arg a]              -- ^List of argdesc.
                -> Map.Map k (Arg a)    -- ^Map from key to argdesc.
    make_keymap :: forall k a.
    (Ord k, Show k) =>
    (Arg a -> Maybe k) -> [Arg a] -> Map k (Arg a)
    make_keymap Arg a -> Maybe k
    f_field [Arg a]
    ads =
        ([(k, Arg a)] -> Map k (Arg a)
    forall k a. (Ord k, Show k) => [(k, a)] -> Map k a
    keymap_from_list ([(k, Arg a)] -> Map k (Arg a))
    -> ([Arg a] -> [(k, Arg a)]) -> [Arg a] -> Map k (Arg a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
         [(Maybe k, Arg a)] -> [(k, Arg a)]
    forall a b. [(Maybe a, b)] -> [(a, b)]
    filter_keys ([(Maybe k, Arg a)] -> [(k, Arg a)])
    -> ([Arg a] -> [(Maybe k, Arg a)]) -> [Arg a] -> [(k, Arg a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
         (Arg a -> (Maybe k, Arg a)) -> [Arg a] -> [(Maybe k, Arg a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Arg a
    arg -> (Arg a -> Maybe k
    f_field Arg a
    arg, Arg a
    arg))) [Arg a]
    ads

    -- |How \"sloppy\" the parse is.
    data ArgsComplete = ArgsComplete         -- ^Any extraneous arguments
                                             -- (unparseable from description)
                                             -- will cause the parser to fail.
                      | ArgsTrailing String  -- ^Trailing extraneous arguments are
                                             -- permitted, and will be skipped,
                                             -- saved, and returned.  The
                                             -- constructor argument is the
                                             -- name of the args.
                      | ArgsInterspersed     -- ^All extraneous arguments are
                                             -- permitted, and will be skipped,
                                             -- saved, and returned.

    -- |Whether to always treat an unknown argument beginning
    -- with \"-\" as an error, or to allow it to be used as a
    -- positional argument when possible.
    data ArgsDash = ArgsHardDash   -- ^If an argument begins with
                                   -- a \"-\", it will always be
                                   -- treated as an error unless
                                   -- it corresponds to a flag description.
                  | ArgsSoftDash   -- ^If an argument beginning with
                                   -- a \"-\" is unrecognized as a flag,
                                   -- treat it as a positional argument
                                   -- if possible. Otherwise it is an error.
                  deriving ArgsDash -> ArgsDash -> Bool
    (ArgsDash -> ArgsDash -> Bool)
    -> (ArgsDash -> ArgsDash -> Bool) -> Eq ArgsDash
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ArgsDash -> ArgsDash -> Bool
    == :: ArgsDash -> ArgsDash -> Bool
    $c/= :: ArgsDash -> ArgsDash -> Bool
    /= :: ArgsDash -> ArgsDash -> Bool
    Eq

    -- |Record containing the collective parse control information.
    data ArgsParseControl = ArgsParseControl {
      -- |Level of completeness of parse.
      ArgsParseControl -> ArgsComplete
    apcComplete :: ArgsComplete,
      -- |Handling of dashes in parse.
      ArgsParseControl -> ArgsDash
    apcDash :: ArgsDash }

    -- |Class for building parse control information,
    -- for backward compatibility.
    class APCData a where
      getAPCData :: a -> ArgsParseControl  -- ^Build an 'ArgsParseControl'
                                           -- structure from the given info.

    instance APCData ArgsParseControl where
      getAPCData :: ArgsParseControl -> ArgsParseControl
    getAPCData ArgsParseControl
    a = ArgsParseControl
    a

    instance APCData ArgsComplete where
      getAPCData :: ArgsComplete -> ArgsParseControl
    getAPCData ArgsComplete
    a = ArgsComplete -> ArgsDash -> ArgsParseControl
    ArgsParseControl ArgsComplete
    a ArgsDash
    ArgsHardDash

    -- |The iteration function is given a state and a list, and
    -- expected to produce a new state and list.  The function
    -- is again invoked with the resulting state and list.  When
    -- the supplied function returns the empty list, this
    -- function returns the final state produced.
    exhaust :: (s -> [e] -> ([e], s))   -- ^Function to iterate.
            -> s                        -- ^Initial state.
            -> [e]                      -- ^Initial list.
            -> s                        -- ^Final state.
    exhaust :: forall s e. (s -> [e] -> ([e], s)) -> s -> [e] -> s
    exhaust s -> [e] -> ([e], s)
    _ s
    s [] = s
    s
    exhaust s -> [e] -> ([e], s)
    f s
    s [e]
    l =
      let ([e]
    l', s
    s') = s -> [e] -> ([e], s)
    f s
    s [e]
    l
      in (s -> [e] -> ([e], s)) -> s -> [e] -> s
    forall s e. (s -> [e] -> ([e], s)) -> s -> [e] -> s
    exhaust s -> [e] -> ([e], s)
    f s
    s' [e]
    l'

    -- |Generate a usage error with the given supplementary message string.
    parseError :: String    -- ^Usage message.
                -> String    -- ^Specific error message.
                -> a         -- ^Bogus polymorphic result.
    parseError :: forall a. String -> String -> a
    parseError String
    usage String
    msg =
      ParseArgsException -> a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (String -> String -> ParseArgsException
    ParseArgsException String
    usage String
    msg)

    -- |Given a description of the arguments, `parseArgs`
    -- produces a map from the arguments to their \"values\" and
    -- some other useful byproducts.  `parseArgs` requires that
    -- the argument descriptions occur in the order 1) flag
    -- arguments, then 2) positional arguments; otherwise a
    -- runtime error will be thrown.
    parseArgs :: (Show a, Ord a, APCData b) =>
                 b              -- ^Configuration for parse.
              -> [ Arg a ]      -- ^Argument descriptions.
              -> String         -- ^Full program pathname.
              -> [ String ]     -- ^Incoming program argument list.
              -> Args a         -- ^Outgoing argument parse results.
    parseArgs :: forall a b.
    (Show a, Ord a, APCData b) =>
    b -> [Arg a] -> String -> [String] -> Args a
    parseArgs b
    apcData [Arg a]
    argd String
    pathname [String]
    argv =
      (forall s. ST s (Args a)) -> Args a
    forall a. (forall s. ST s a) -> a
    runST (do
               ST s ()
    forall s. ST s ()
    check_argd
               let ([Arg a]
    flag_args, [Arg a]
    posn_args) = (Arg a -> Bool) -> [Arg a] -> ([Arg a], [Arg a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_flag [Arg a]
    argd
               let name_hash :: Map String (Arg a)
    name_hash = (Arg a -> Maybe String) -> [Arg a] -> Map String (Arg a)
    forall k a.
    (Ord k, Show k) =>
    (Arg a -> Maybe k) -> [Arg a] -> Map k (Arg a)
    make_keymap Arg a -> Maybe String
    forall a. Ord a => Arg a -> Maybe String
    argName [Arg a]
    flag_args
               let abbr_hash :: Map Char (Arg a)
    abbr_hash = (Arg a -> Maybe Char) -> [Arg a] -> Map Char (Arg a)
    forall k a.
    (Ord k, Show k) =>
    (Arg a -> Maybe k) -> [Arg a] -> Map k (Arg a)
    make_keymap Arg a -> Maybe Char
    forall a. Ord a => Arg a -> Maybe Char
    argAbbr [Arg a]
    flag_args
               let prog_name :: String
    prog_name = ShowS
    baseName String
    pathname
               let usage :: String
    usage = ShowS
    make_usage_string String
    prog_name
               let (Map a Argval
    am, [Arg a]
    _, [String]
    rest) = ((Map a Argval, [Arg a], [String])
     -> [String] -> ([String], (Map a Argval, [Arg a], [String])))
    -> (Map a Argval, [Arg a], [String])
    -> [String]
    -> (Map a Argval, [Arg a], [String])
    forall s e. (s -> [e] -> ([e], s)) -> s -> [e] -> s
    exhaust (String
    -> Map String (Arg a)
    -> Map Char (Arg a)
    -> (Map a Argval, [Arg a], [String])
    -> [String]
    -> ([String], (Map a Argval, [Arg a], [String]))
    forall {a}.
    Ord a =>
    String
    -> Map String (Arg a)
    -> Map Char (Arg a)
    -> (Map a Argval, [Arg a], [String])
    -> [String]
    -> ([String], (Map a Argval, [Arg a], [String]))
    parse String
    usage Map String (Arg a)
    name_hash Map Char (Arg a)
    abbr_hash)
                                    (Map a Argval
    forall k a. Map k a
    Map.empty, [Arg a]
    posn_args, [])
                                    [String]
    argv
               let required_args :: [Arg a]
    required_args = (Arg a -> Bool) -> [Arg a] -> [Arg a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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. Ord a => Arg a -> Bool
    arg_optional) [Arg a]
    argd
               Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ((Arg a -> Bool) -> [Arg a] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Map a Argval -> Arg a -> Bool
    forall {a} {a}. Ord a => String -> Map a a -> Arg a -> Bool
    check_present String
    usage Map a Argval
    am) [Arg a]
    required_args))
                      (String -> ST s ()
    forall a. HasCallStack => String -> a
    error String
    "internal error")
               let am' :: Map a Argval
    am' = (Map a Argval -> Arg a -> Map a Argval)
    -> Map a Argval -> [Arg a] -> Map a Argval
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Map a Argval -> Arg a -> Map a Argval
    forall {a}. Ord a => Map a Argval -> Arg a -> Map a Argval
    supply_defaults Map a Argval
    am [Arg a]
    argd
               Args a -> ST s (Args a)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Args { __args :: ArgRecord a
    __args = Map a Argval -> ArgRecord a
    forall a. Map a Argval -> ArgRecord a
    ArgRecord Map a Argval
    am',
                              argsProgName :: String
    argsProgName = String
    prog_name,
                              argsUsage :: String
    argsUsage = String
    usage,
                              argsRest :: [String]
    argsRest = [String]
    rest }))
      where
        supply_defaults :: Map a Argval -> Arg a -> Map a Argval
    supply_defaults Map a Argval
    am ad :: Arg a
    ad@(Arg { argIndex :: forall a. Ord a => Arg a -> a
    argIndex = a
    k }) =
            case a -> Map a Argval -> Maybe Argval
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup a
    k Map a Argval
    am of
              Just Argval
    _ -> Map a Argval
    am
              Maybe Argval
    Nothing -> case Arg a -> Maybe Argval
    forall a. Ord a => Arg a -> Maybe Argval
    arg_default_value Arg a
    ad of
                           Just Argval
    v -> a -> Argval -> Map a Argval -> Map a Argval
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert a
    k Argval
    v Map a Argval
    am
                           Maybe Argval
    Nothing -> Map a Argval
    am
        check_present :: String -> Map a a -> Arg a -> Bool
    check_present String
    usage Map a a
    am ad :: Arg a
    ad@(Arg { argIndex :: forall a. Ord a => Arg a -> a
    argIndex = a
    k }) =
            case a -> Map a a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup a
    k Map a a
    am of
              Just a
    _ -> Bool
    True
              Maybe a
    Nothing -> String -> String -> Bool
    forall a. String -> String -> a
    parseError String
    usage (String
    "missing required argument " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                            (Arg a -> String
    forall a. Ord a => Arg a -> String
    arg_string Arg a
    ad))
        --- Check for various possible misuses.
        check_argd :: ST s ()
        check_argd :: forall s. ST s ()
    check_argd = do
          --- Order must be flags, then posn args
          let ([Arg a]
    _, [Arg a]
    posns) = (Arg a -> Bool) -> [Arg a] -> ([Arg a], [Arg a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_flag [Arg a]
    argd
          Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((Arg a -> Bool) -> [Arg a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_posn [Arg a]
    posns)
                 (String -> ST s ()
    forall a. String -> a
    argdesc_error String
    "argument description mixes flags and positionals")
          --- No argument may be "nullary".
          Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ((Arg a -> Bool) -> [Arg a] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_nullary [Arg a]
    argd))
               (String -> ST s ()
    forall a. String -> a
    argdesc_error String
    "bogus 'nothing' argument")
          () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          where
            arg_nullary :: Arg a -> Bool
    arg_nullary (Arg { argName :: forall a. Ord a => Arg a -> Maybe String
    argName = Maybe String
    Nothing,
                               argAbbr :: forall a. Ord a => Arg a -> Maybe Char
    argAbbr = Maybe Char
    Nothing,
                               argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Maybe DataArg
    Nothing }) = Bool
    True
            arg_nullary Arg a
    _ = Bool
    False
        --- Generate a usage message string
        make_usage_string :: ShowS
    make_usage_string String
    prog_name =
          String
    summary_line String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    arg_lines
          where
            flag_args :: [Arg a]
    flag_args = (Arg a -> Bool) -> [Arg a] -> [Arg a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_flag [Arg a]
    argd
            posn_args :: [Arg a]
    posn_args = (Arg a -> Bool) -> [Arg a] -> [Arg a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_posn [Arg a]
    argd
            n :: Int
    n = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ((Arg a -> Int) -> [Arg a] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (Arg a -> String) -> Arg a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg a -> String
    forall a. Ord a => Arg a -> String
    arg_string) [Arg a]
    argd)
            --- top (summary) line
            summary_line :: String
    summary_line =
                String
    "usage: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    prog_name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                Bool -> ShowS
    perhaps
                  (Bool -> Bool
    not ([Arg a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Arg a]
    flag_args))
                  String
    " [options]" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                Bool -> ShowS
    perhaps
                  (Bool -> Bool
    not ([Arg a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Arg a]
    posn_args))
                  (String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((Arg a -> String) -> [Arg a] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg a -> String
    forall a. Ord a => Arg a -> String
    arg_string [Arg a]
    posn_args)) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                (case ArgsParseControl -> ArgsComplete
    apcComplete (ArgsParseControl -> ArgsComplete)
    -> ArgsParseControl -> ArgsComplete
    forall a b. (a -> b) -> a -> b
    $ b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData of
                   ArgsComplete
    ArgsComplete -> String
    ""
                   ArgsTrailing String
    s -> String
    " [--] [" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " ...]"
                   ArgsComplete
    ArgsInterspersed -> String
    " ... [--] ...") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            --- argument lines
            arg_lines :: String
    arg_lines = (Arg a -> String) -> [Arg a] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> Arg a -> String
    forall {a}. Ord a => Int -> Arg a -> String
    arg_line Int
    n) [Arg a]
    argd where
                arg_line :: Int -> Arg a -> String
    arg_line Int
    na Arg a
    a =
                    let s :: String
    s = Arg a -> String
    forall a. Ord a => Arg a -> String
    arg_string Arg a
    a in
                    String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                    Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    na Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s)) Char
    ' ' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                    String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Arg a -> String
    forall a. Ord a => Arg a -> String
    argDesc Arg a
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
        --- simple recursive-descent parser
        parse :: String
    -> Map String (Arg a)
    -> Map Char (Arg a)
    -> (Map a Argval, [Arg a], [String])
    -> [String]
    -> ([String], (Map a Argval, [Arg a], [String]))
    parse String
    _ Map String (Arg a)
    _ Map Char (Arg a)
    _ av :: (Map a Argval, [Arg a], [String])
    av@(Map a Argval
    _, [Arg a]
    _, []) [] = ([], (Map a Argval, [Arg a], [String])
    av)
        parse String
    usage Map String (Arg a)
    _ Map Char (Arg a)
    _ (Map a Argval, [Arg a], [String])
    av [] =
            case ArgsParseControl -> ArgsComplete
    apcComplete (ArgsParseControl -> ArgsComplete)
    -> ArgsParseControl -> ArgsComplete
    forall a b. (a -> b) -> a -> b
    $ b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData of
              ArgsComplete
    ArgsComplete -> String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage String
    "unexpected extra arguments"
              ArgsComplete
    _ -> ([], (Map a Argval, [Arg a], [String])
    av)
        parse String
    usage Map String (Arg a)
    name_hash Map Char (Arg a)
    abbr_hash (Map a Argval
    am, [Arg a]
    posn, [String]
    rest) av :: [String]
    av@(String
    aa : [String]
    aas) =
            case String
    aa of
              String
    "--" -> case b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData of
                        ArgsParseControl ArgsComplete
    ArgsComplete ArgsDash
    ArgsHardDash ->
                          String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage (String
    "unexpected -- " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                            String
    "(extra arguments not allowed)")
                        ArgsParseControl
    _ -> ([], (Map a Argval
    am, [Arg a]
    posn, ([String]
    rest [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    aas)))
              s :: String
    s@(Char
    '-' : Char
    '-' : String
    name)
                | Maybe (Arg a) -> Bool
    forall a. Maybe a -> Bool
    isJust (String -> Map String (Arg a) -> Maybe (Arg a)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    name Map String (Arg a)
    name_hash) Bool -> Bool -> Bool
    ||
                  ArgsParseControl -> ArgsDash
    apcDash (b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData) ArgsDash -> ArgsDash -> Bool
    forall a. Eq a => a -> a -> Bool
    == ArgsDash
    ArgsHardDash ->
                  case String -> Map String (Arg a) -> Maybe (Arg a)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    name Map String (Arg a)
    name_hash of
                    Just Arg a
    ad ->
                      let ([String]
    args', Map a Argval
    am') = String -> Arg a -> [String] -> ([String], Map a Argval)
    peel String
    s Arg a
    ad [String]
    aas in
                      ([String]
    args', (Map a Argval
    am', [Arg a]
    posn, [String]
    rest))
                    Maybe (Arg a)
    Nothing ->
                      case b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData of
                        ArgsParseControl ArgsComplete
    ArgsInterspersed ArgsDash
    _ ->
                          ([String]
    aas, (Map a Argval
    am, [Arg a]
    posn, [String]
    rest [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "--" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name]))
                        ArgsParseControl
    _ ->
                          String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage
                            (String
    "unknown argument --" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name)
              (Char
    '-' : Char
    abbr : String
    abbrs)
                | Maybe (Arg a) -> Bool
    forall a. Maybe a -> Bool
    isJust (Char -> Map Char (Arg a) -> Maybe (Arg a)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Char
    abbr Map Char (Arg a)
    abbr_hash) Bool -> Bool -> Bool
    ||
                  ArgsParseControl -> ArgsDash
    apcDash (b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData) ArgsDash -> ArgsDash -> Bool
    forall a. Eq a => a -> a -> Bool
    == ArgsDash
    ArgsHardDash ->
                  case Char -> Map Char (Arg a) -> Maybe (Arg a)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Char
    abbr Map Char (Arg a)
    abbr_hash of
                    Just Arg a
    ad ->
                      let ([String]
    args', Map a Argval
    am') = String -> Arg a -> [String] -> ([String], Map a Argval)
    peel [Char
    '-', Char
    abbr] Arg a
    ad [String]
    aas
                          state' :: (Map a Argval, [Arg a], [String])
    state' = (Map a Argval
    am', [Arg a]
    posn, [String]
    rest)
                      in case String
    abbrs of
                        [] -> ([String]
    args', (Map a Argval, [Arg a], [String])
    state')
                        (Char
    '-' : String
    _) -> String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage
                                     (String
    "bad internal '-' in argument " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    aa)
                        String
    _ -> ([Char
    '-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    abbrs] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    args', (Map a Argval, [Arg a], [String])
    state')
                    Maybe (Arg a)
    Nothing ->
                        case ArgsParseControl -> ArgsComplete
    apcComplete (ArgsParseControl -> ArgsComplete)
    -> ArgsParseControl -> ArgsComplete
    forall a b. (a -> b) -> a -> b
    $ b -> ArgsParseControl
    forall a. APCData a => a -> ArgsParseControl
    getAPCData b
    apcData of
                          ArgsComplete
    ArgsInterspersed ->
                              ([String]
    aas,
                               (Map a Argval
    am, [Arg a]
    posn, [String]
    rest [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    abbr Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    abbrs]))
                          ArgsComplete
    _ -> String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage
                               (String
    "unknown argument -" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    abbr])
              String
    _ ->
                case [Arg a]
    posn of
                  (Arg a
    p : [Arg a]
    ps) ->
                    let ([Arg a]
    _, [Arg a]
    req_posn) = (Arg a -> Bool) -> [Arg a] -> ([Arg a], [Arg a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_optional [Arg a]
    posn in
                    case [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    av Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Arg a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Arg a]
    req_posn of
                      Int
    n_extra | Int
    n_extra Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    || (Int
    n_extra Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Arg a -> Bool
    forall a. Ord a => Arg a -> Bool
    arg_required Arg a
    p) ->
                        let ([String]
    args', Map a Argval
    am') = String -> Arg a -> [String] -> ([String], Map a Argval)
    peel (DataArg -> String
    dataArgName (DataArg -> String) -> DataArg -> String
    forall a b. (a -> b) -> a -> b
    $ Maybe DataArg -> DataArg
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe DataArg -> DataArg) -> Maybe DataArg -> DataArg
    forall a b. (a -> b) -> a -> b
    $
                                                 Arg a -> Maybe DataArg
    forall a. Ord a => Arg a -> Maybe DataArg
    argData Arg a
    p) Arg a
    p [String]
    av in
                        ([String]
    args', (Map a Argval
    am', [Arg a]
    ps, [String]
    rest))
                      Int
    0 -> ([String]
    av, (Map a Argval
    am, [Arg a]
    ps, [String]
    rest))
                      Int
    _ -> String -> String -> ([String], (Map a Argval, [Arg a], [String]))
    forall a. String -> String -> a
    parseError String
    usage
                             String
    "missing required positional argument(s)"
                  [] -> ([], (Map a Argval
    am, [], [String]
    rest [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    av))
            where
              add_entry :: String -> Map k a -> (k, a) -> Map k a
    add_entry String
    s Map k a
    m (k
    k, a
    a) =
                  case k -> Map k a -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member k
    k Map k a
    m of
                    Bool
    False -> k -> a -> Map k a -> Map k a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert k
    k a
    a Map k a
    m
                    Bool
    True -> String -> String -> Map k a
    forall a. String -> String -> a
    parseError String
    usage (String
    "duplicate argument " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
              peel :: String -> Arg a -> [String] -> ([String], Map a Argval)
    peel String
    name (Arg { argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Maybe DataArg
    Nothing, argIndex :: forall a. Ord a => Arg a -> a
    argIndex = a
    index }) [String]
    argl =
                  let am' :: Map a Argval
    am' = String -> Map a Argval -> (a, Argval) -> Map a Argval
    forall {k} {a}. Ord k => String -> Map k a -> (k, a) -> Map k a
    add_entry String
    name Map a Argval
    am (a
    index, Argval
    ArgvalFlag)
                  in ([String]
    argl, Map a Argval
    am')
              peel String
    name (Arg { argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData = Just (DataArg {}) }) [] =
                  String -> String -> ([String], Map a Argval)
    forall a. String -> String -> a
    parseError String
    usage (String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " is missing its argument")
              peel String
    name (Arg { argData :: forall a. Ord a => Arg a -> Maybe DataArg
    argData =
                                     Just (DataArg { dataArgArgtype :: DataArg -> Argtype
    dataArgArgtype = Argtype
    atype }),
                                  argIndex :: forall a. Ord a => Arg a -> a
    argIndex = a
    index })
                  (String
    a : [String]
    argl) =
                    let v :: Argval
    v = case Argtype
    atype of
                              ArgtypeString Maybe String
    _ -> String -> Argval
    ArgvalString String
    a
                              ArgtypeInteger Maybe Integer
    _ -> (Integer -> Argval) -> String -> Argval
    forall {t} {t}. Read t => (t -> t) -> String -> t
    read_arg Integer -> Argval
    ArgvalInteger
                                                           String
    "an integer"
                              ArgtypeInt Maybe Int
    _ -> (Int -> Argval) -> String -> Argval
    forall {t} {t}. Read t => (t -> t) -> String -> t
    read_arg Int -> Argval
    ArgvalInt String
    "an int"
                              ArgtypeDouble Maybe Double
    _ -> (Double -> Argval) -> String -> Argval
    forall {t} {t}. Read t => (t -> t) -> String -> t
    read_arg Double -> Argval
    ArgvalDouble String
    "a double"
                              ArgtypeFloat Maybe Float
    _ -> (Float -> Argval) -> String -> Argval
    forall {t} {t}. Read t => (t -> t) -> String -> t
    read_arg Float -> Argval
    ArgvalFloat String
    "a float"
                            where
                              read_arg :: (t -> t) -> String -> t
    read_arg t -> t
    constructor String
    kind =
                                case ReadS t
    forall a. Read a => ReadS a
    reads String
    a of
                                  [(t
    val, String
    "")] -> t -> t
    constructor t
    val
                                  [(t, String)]
    _ -> String -> String -> t
    forall a. String -> String -> a
    parseError String
    usage (String
    "argument " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                                         String
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " to " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                                         String
    " is not " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    kind)
                        am' :: Map a Argval
    am' = String -> Map a Argval -> (a, Argval) -> Map a Argval
    forall {k} {a}. Ord k => String -> Map k a -> (k, a) -> Map k a
    add_entry String
    name Map a Argval
    am (a
    index, Argval
    v)
                    in ([String]
    argl, Map a Argval
    am')

    -- |Most of the time, you just want the environment's
    -- arguments and are willing to live in the IO monad.
    -- This version of `parseArgs` digs the pathname and arguments
    -- out of the system directly.
    parseArgsIO :: (Show a, Ord a, APCData b) =>
                   b             -- ^Degree of completeness of parse.
                -> [ Arg a ]     -- ^Argument descriptions.
                -> IO (Args a)   -- ^Argument parse results.
    parseArgsIO :: forall a b.
    (Show a, Ord a, APCData b) =>
    b -> [Arg a] -> IO (Args a)
    parseArgsIO b
    apcData [Arg a]
    argd = do
      argv <- IO [String]
    getArgs
      pathname <- getProgName
      return (parseArgs apcData argd pathname argv)

    -- |Check whether a given optional argument was supplied. Works on all types.
    gotArg :: (Ord a) =>
              Args a    -- ^Parsed arguments.
           -> a         -- ^Index of argument to be checked for.
           -> Bool      -- ^True if the arg was present.
    gotArg :: forall a. Ord a => Args a -> a -> Bool
    gotArg (Args { __args :: forall a. Ord a => Args a -> ArgRecord a
    __args = ArgRecord Map a Argval
    am }) a
    k =
        case a -> Map a Argval -> Maybe Argval
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup a
    k Map a Argval
    am of
          Just Argval
    _ -> Bool
    True
          Maybe Argval
    Nothing -> Bool
    False

    -- |Type of values that can be parsed by the argument parser.
    class ArgType b where

        -- |Fetch an argument's value if it is present.
        getArg :: (Show a, Ord a)
               => Args a    -- ^Parsed arguments.
               -> a         -- ^Index of argument to be retrieved.
               -> Maybe b   -- ^Argument value if present.

        -- |Fetch the value of a required argument.
        getRequiredArg :: (Show a, Ord a)
               => Args a    -- ^Parsed arguments.
               -> a         -- ^Index of argument to be retrieved.
               -> b   -- ^Argument value.

        getRequiredArg Args a
    ads a
    index =
            case Args a -> a -> Maybe b
    forall a. (Show a, Ord a) => Args a -> a -> Maybe b
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg Args a
    ads a
    index of
              Just b
    v -> b
    v
              Maybe b
    Nothing -> String -> b
    forall a. HasCallStack => String -> a
    error (String
    "internal error: required argument "
                              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    index String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "not supplied")

    getArgPrimitive :: Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive :: forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe b
    decons (Args { __args :: forall a. Ord a => Args a -> ArgRecord a
    __args = ArgRecord Map a Argval
    am }) a
    k =
      a -> Map a Argval -> Maybe Argval
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup a
    k Map a Argval
    am Maybe Argval -> (Argval -> Maybe b) -> Maybe b
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Argval -> Maybe b
    decons

    instance ArgType () where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe ()
    getArg =
          (Argval -> Maybe ()) -> Args a -> a -> Maybe ()
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe ()
    forall {m :: * -> *}. Monad m => Argval -> m ()
    flagArg
          where
            flagArg :: Argval -> m ()
    flagArg Argval
    ArgvalFlag = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            flagArg Argval
    _ = String -> m ()
    forall a. HasCallStack => String -> a
    error String
    "internal error: flag arg at wrong type"

    instance ArgType ([] Char) where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe String
    getArg =
          (Argval -> Maybe String) -> Args a -> a -> Maybe String
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe String
    forall {m :: * -> *}. Monad m => Argval -> m String
    stringArg
          where
            stringArg :: Argval -> m String
    stringArg (ArgvalString String
    s) = String -> m String
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s
            stringArg Argval
    _ = String -> m String
    forall a. HasCallStack => String -> a
    error String
    "internal error: string arg at wrong type"

    -- |[Deprecated]  Return the `String` value, if any, of the given argument.
    getArgString :: (Show a, Ord a) =>
                    Args a         -- ^Parsed arguments.
                 -> a              -- ^Index of argument to be retrieved.
                 -> Maybe String   -- ^Argument value if present.
    getArgString :: forall a. (Show a, Ord a) => Args a -> a -> Maybe String
    getArgString = Args a -> a -> Maybe String
    forall a. (Show a, Ord a) => Args a -> a -> Maybe String
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg

    instance ArgType Integer where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Integer
    getArg =
          (Argval -> Maybe Integer) -> Args a -> a -> Maybe Integer
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe Integer
    forall {m :: * -> *}. Monad m => Argval -> m Integer
    integerArg
          where
            integerArg :: Argval -> m Integer
    integerArg (ArgvalInteger Integer
    i) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    i
            integerArg Argval
    _ = String -> m Integer
    forall a. HasCallStack => String -> a
    error String
    "internal error: integer arg at wrong type"

    -- |[Deprecated] Return the `Integer` value, if any, of the given argument.
    getArgInteger :: (Show a, Ord a) =>
                     Args a          -- ^Parsed arguments.
                  -> a               -- ^Index of argument to be retrieved.
                  -> Maybe Integer   -- ^Argument value if present.
    getArgInteger :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Integer
    getArgInteger = Args a -> a -> Maybe Integer
    forall a. (Show a, Ord a) => Args a -> a -> Maybe Integer
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg

    instance ArgType Int where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Int
    getArg =
          (Argval -> Maybe Int) -> Args a -> a -> Maybe Int
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe Int
    forall {m :: * -> *}. Monad m => Argval -> m Int
    intArg
          where
            intArg :: Argval -> m Int
    intArg (ArgvalInt Int
    i) = Int -> m Int
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    i
            intArg Argval
    _ = String -> m Int
    forall a. HasCallStack => String -> a
    error String
    "internal error: int arg at wrong type"

    -- |[Deprecated] Return the `Int` value, if any, of the given argument.
    getArgInt :: (Show a, Ord a) =>
                 Args a      -- ^Parsed arguments.
              -> a           -- ^Index of argument to be retrieved.
              -> Maybe Int   -- ^Argument value if present.
    getArgInt :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Int
    getArgInt = Args a -> a -> Maybe Int
    forall a. (Show a, Ord a) => Args a -> a -> Maybe Int
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg

    instance ArgType Double where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Double
    getArg =
          (Argval -> Maybe Double) -> Args a -> a -> Maybe Double
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe Double
    forall {m :: * -> *}. Monad m => Argval -> m Double
    doubleArg
          where
            doubleArg :: Argval -> m Double
    doubleArg (ArgvalDouble Double
    d) = Double -> m Double
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Double
    d
            doubleArg Argval
    _ = String -> m Double
    forall a. HasCallStack => String -> a
    error String
    "internal error: double arg at wrong type"

    -- |[Deprecated] Return the `Double` value, if any, of the given argument.
    getArgDouble :: (Show a, Ord a) =>
                    Args a         -- ^Parsed arguments.
                 -> a              -- ^Index of argument to be retrieved.
                 -> Maybe Double   -- ^Argument value if present.
    getArgDouble :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Double
    getArgDouble = Args a -> a -> Maybe Double
    forall a. (Show a, Ord a) => Args a -> a -> Maybe Double
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg

    instance ArgType Float where
      getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Float
    getArg =
          (Argval -> Maybe Float) -> Args a -> a -> Maybe Float
    forall a b. Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b
    getArgPrimitive Argval -> Maybe Float
    forall {m :: * -> *}. Monad m => Argval -> m Float
    floatArg
          where
            floatArg :: Argval -> m Float
    floatArg (ArgvalFloat Float
    f) = Float -> m Float
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Float
    f
            floatArg Argval
    _ = String -> m Float
    forall a. HasCallStack => String -> a
    error String
    "internal error: float arg at wrong type"

    -- |[Deprecated] Return the `Float` value, if any, of the given argument.
    getArgFloat :: (Show a, Ord a) =>
                   Args a        -- ^Parsed arguments.
                -> a             -- ^Index of argument to be retrieved.
                -> Maybe Float   -- ^Argument value if present.
    getArgFloat :: forall a. (Show a, Ord a) => Args a -> a -> Maybe Float
    getArgFloat = Args a -> a -> Maybe Float
    forall a. (Show a, Ord a) => Args a -> a -> Maybe Float
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg

    -- |`ArgType` instance for opening a file from its string name.
    newtype ArgFileOpener = ArgFileOpener {
          ArgFileOpener -> IOMode -> IO Handle
    argFileOpener :: IOMode -> IO Handle  -- ^Function to open the file
        }

    instance ArgType ArgFileOpener where
        getArg :: forall a. (Show a, Ord a) => Args a -> a -> Maybe ArgFileOpener
    getArg Args a
    ads a
    index =
            Args a -> a -> Maybe String
    forall a. (Show a, Ord a) => Args a -> a -> Maybe String
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg Args a
    ads a
    index Maybe String
    -> (String -> Maybe ArgFileOpener) -> Maybe ArgFileOpener
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              (\String
    s -> ArgFileOpener -> Maybe ArgFileOpener
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ArgFileOpener -> Maybe ArgFileOpener)
    -> ArgFileOpener -> Maybe ArgFileOpener
    forall a b. (a -> b) -> a -> b
    $ ArgFileOpener { argFileOpener :: IOMode -> IO Handle
    argFileOpener = String -> IOMode -> IO Handle
    openFile String
    s })

    -- |[Deprecated] Treat the `String` value, if any, of the given argument as
    -- a file handle and try to open it as requested.
    getArgFile :: (Show a, Ord a) =>
                  Args a              -- ^Parsed arguments.
               -> a                   -- ^Index of argument to be retrieved.
               -> IOMode              -- ^IO mode the file should be opened in.
               -> IO (Maybe Handle)   -- ^Handle of opened file, if the argument
                                      -- was present.
    getArgFile :: forall a.
    (Show a, Ord a) =>
    Args a -> a -> IOMode -> IO (Maybe Handle)
    getArgFile Args a
    ads a
    k IOMode
    m =
      case Args a -> a -> Maybe ArgFileOpener
    forall a. (Show a, Ord a) => Args a -> a -> Maybe ArgFileOpener
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg Args a
    ads a
    k of
        Just ArgFileOpener
    fo -> (do h <- ArgFileOpener -> IOMode -> IO Handle
    argFileOpener ArgFileOpener
    fo IOMode
    m; return (Just h))
        Maybe ArgFileOpener
    Nothing -> Maybe Handle -> IO (Maybe Handle)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Handle
    forall a. Maybe a
    Nothing

    -- |Treat the `String` value, if any, of the given argument as a
    -- file handle and try to open it as requested.  If not
    -- present, substitute the appropriate one of stdin or
    -- stdout as indicated by `IOMode`.
    getArgStdio :: (Show a, Ord a) =>
                   Args a      -- ^Parsed arguments.
                -> a           -- ^Index of argument to be retrieved.
                -> IOMode      -- ^IO mode the file should be opened in.
                               -- Must not be `ReadWriteMode`.
                -> IO Handle   -- ^Appropriate file handle.
    getArgStdio :: forall a. (Show a, Ord a) => Args a -> a -> IOMode -> IO Handle
    getArgStdio Args a
    ads a
    k IOMode
    m =
        case Args a -> a -> Maybe String
    forall a. (Show a, Ord a) => Args a -> a -> Maybe String
    forall b a. (ArgType b, Show a, Ord a) => Args a -> a -> Maybe b
    getArg Args a
    ads a
    k of
          Just String
    s -> String -> IOMode -> IO Handle
    openFile String
    s IOMode
    m
          Maybe String
    Nothing ->
              case IOMode
    m of
                IOMode
    ReadMode -> Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdin
                IOMode
    WriteMode -> Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdout
                IOMode
    AppendMode -> Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdout
                IOMode
    ReadWriteMode ->
                         String -> IO Handle
    forall a. HasCallStack => String -> a
    error (String
    "internal error: tried to open stdio "
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "in ReadWriteMode")

    ---
    --- Misc
    ---

    -- |Return the filename part of a pathname.
    -- Unnecessarily efficient implementation does a single
    -- tail-call traversal with no construction.
    baseName :: String   -- ^Pathname.
             -> String   -- ^Rightmost component of pathname.
    baseName :: ShowS
    baseName String
    s =
        let s' :: String
    s' = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') String
    s in
        if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s' then String
    s else ShowS
    baseName (ShowS
    forall a. HasCallStack => [a] -> [a]
    tail String
    s')

    -- |Generate a usage error with the given supplementary message string.
    usageError :: (Ord a) => Args a -> String -> b
    usageError :: forall a b. Ord a => Args a -> String -> b
    usageError Args a
    ads String
    msg = String -> b
    forall a. HasCallStack => String -> a
    error (Args a -> String
    forall a. Ord a => Args a -> String
    argsUsage Args a
    ads String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)