    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE TupleSections #-}

    -----------------------------------------------------------------------------

    -- |
    -- Module      :  Distribution.GetOpt
    -- Copyright   :  (c) Sven Panne 2002-2005
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Portability :  portable
    --
    -- This is a fork of "System.Console.GetOpt" with the following changes:
    --
    -- * Treat "cabal --flag command" as "cabal command --flag" e.g.
    --   "cabal -v configure" to mean "cabal configure -v" For flags that are
    --   not recognised as global flags, pass them on to the sub-command. See
    --   the difference in 'shortOpt'.
    --
    -- * Line wrapping in the 'usageInfo' output, plus a more compact
    --   rendering of short options, and slightly less padding.
    --
    -- * Parsing of option arguments is allowed to fail.
    --
    -- * 'ReturnInOrder' argument order is removed.
    module Distribution.GetOpt
      ( -- * GetOpt
        getOpt
      , getOpt'
      , usageInfo
      , ArgOrder (..)
      , OptDescr (..)
      , ArgDescr (..)

        -- * Example

        -- | See "System.Console.GetOpt" for examples
      ) where

    import Distribution.Compat.Prelude
    import Prelude ()

    -- | What to do with options following non-options
    data ArgOrder a
      = -- | no option processing after first non-option
        RequireOrder
      | -- | freely intersperse options and non-options
        Permute

    data OptDescr a -- description of a single options:
      = Option
          [Char] --    list of short option characters
          [String] --    list of long option strings (without "--")
          (ArgDescr a) --    argument descriptor
          String --    explanation of option for user

    instance Functor OptDescr where
      fmap :: forall a b. (a -> b) -> OptDescr a -> OptDescr b
    fmap a -> b
    f (Option [Char]
    a [[Char]]
    b ArgDescr a
    argDescr [Char]
    c) = [Char] -> [[Char]] -> ArgDescr b -> [Char] -> OptDescr b
    forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
    Option [Char]
    a [[Char]]
    b ((a -> b) -> ArgDescr a -> ArgDescr b
    forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f ArgDescr a
    argDescr) [Char]
    c

    -- | Describes whether an option takes an argument or not, and if so
    -- how the argument is parsed to a value of type @a@.
    --
    -- Compared to System.Console.GetOpt, we allow for parse errors.
    data ArgDescr a
      = -- |   no argument expected
        NoArg a
      | -- |   option requires argument
        ReqArg (String -> Either String a) String
      | -- |   optional argument
        OptArg String (Maybe String -> Either String a) String

    instance Functor ArgDescr where
      fmap :: forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
    fmap a -> b
    f (NoArg a
    a) = b -> ArgDescr b
    forall a. a -> ArgDescr a
    NoArg (a -> b
    f a
    a)
      fmap a -> b
    f (ReqArg [Char] -> Either [Char] a
    g [Char]
    s) = ([Char] -> Either [Char] b) -> [Char] -> ArgDescr b
    forall a. ([Char] -> Either [Char] a) -> [Char] -> ArgDescr a
    ReqArg ((a -> b) -> Either [Char] a -> Either [Char] b
    forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Either [Char] a -> Either [Char] b)
    -> ([Char] -> Either [Char] a) -> [Char] -> Either [Char] b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Either [Char] a
    g) [Char]
    s
      fmap a -> b
    f (OptArg [Char]
    dv Maybe [Char] -> Either [Char] a
    g [Char]
    s) = [Char] -> (Maybe [Char] -> Either [Char] b) -> [Char] -> ArgDescr b
    forall a.
    [Char] -> (Maybe [Char] -> Either [Char] a) -> [Char] -> ArgDescr a
    OptArg [Char]
    dv ((a -> b) -> Either [Char] a -> Either [Char] b
    forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Either [Char] a -> Either [Char] b)
    -> (Maybe [Char] -> Either [Char] a)
    -> Maybe [Char]
    -> Either [Char] b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe [Char] -> Either [Char] a
    g) [Char]
    s

    data OptKind a -- kind of cmd line arg (internal use only):
      = Opt a --    an option
      | UnreqOpt String --    an un-recognized option
      | NonOpt String --    a non-option
      | EndOfOpts --    end-of-options marker (i.e. "--")
      | OptErr String --    something went wrong...

    data OptHelp = OptHelp
      { OptHelp -> [Char]
    optNames :: String
      , OptHelp -> [Char]
    optHelp :: String
      }

    -- | Return a string describing the usage of a command, derived from
    -- the header (first argument) and the options described by the
    -- second argument.
    usageInfo
      :: String -- header
      -> [OptDescr a] -- option descriptors
      -> String -- nicely formatted description of options
    usageInfo :: forall a. [Char] -> [OptDescr a] -> [Char]
    usageInfo [Char]
    header [OptDescr a]
    optDescr = [[Char]] -> [Char]
    unlines ([Char]
    header [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    table)
      where
        options :: [OptHelp]
    options = ((OptDescr a -> OptHelp) -> [OptDescr a] -> [OptHelp])
    -> [OptDescr a] -> (OptDescr a -> OptHelp) -> [OptHelp]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (OptDescr a -> OptHelp) -> [OptDescr a] -> [OptHelp]
    forall a b. (a -> b) -> [a] -> [b]
    map [OptDescr a]
    optDescr ((OptDescr a -> OptHelp) -> [OptHelp])
    -> (OptDescr a -> OptHelp) -> [OptHelp]
    forall a b. (a -> b) -> a -> b
    $ \(Option [Char]
    sos [[Char]]
    los ArgDescr a
    ad [Char]
    d) ->
          OptHelp
            { optNames :: [Char]
    optNames =
                [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $
                  (Char -> [Char]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (ArgDescr a -> Char -> [Char]
    forall a. ArgDescr a -> Char -> [Char]
    fmtShort ArgDescr a
    ad) [Char]
    sos
                    [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (ArgDescr a -> [Char] -> [Char]
    forall a. ArgDescr a -> [Char] -> [Char]
    fmtLong ArgDescr a
    ad) (Int -> [[Char]] -> [[Char]]
    forall a. Int -> [a] -> [a]
    take Int
    1 [[Char]]
    los)
            , optHelp :: [Char]
    optHelp = [Char]
    d
            }

        maxOptNameWidth :: Int
    maxOptNameWidth = Int
    30
        descolWidth :: Int
    descolWidth = Int
    80 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    maxOptNameWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)

        table :: [String]
        table :: [[Char]]
    table = do
          OptHelp{optNames, optHelp} <- [OptHelp]
    options
          let wrappedHelp = Int -> [Char] -> [[Char]]
    wrapText Int
    descolWidth [Char]
    optHelp
          if length optNames >= maxOptNameWidth
            then
              [" " ++ optNames]
                ++ renderColumns [] wrappedHelp
            else renderColumns [optNames] wrappedHelp

        renderColumns :: [String] -> [String] -> [String]
        renderColumns :: [[Char]] -> [[Char]] -> [[Char]]
    renderColumns [[Char]]
    xs [[Char]]
    ys = do
          (x, y) <- [Char] -> [Char] -> [[Char]] -> [[Char]] -> [([Char], [Char])]
    forall a b. a -> b -> [a] -> [b] -> [(a, b)]
    zipDefault [Char]
    "" [Char]
    "" [[Char]]
    xs [[Char]]
    ys
          return $ " " ++ padTo maxOptNameWidth x ++ " " ++ y

        padTo :: Int -> [Char] -> [Char]
    padTo Int
    n [Char]
    x = Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    take Int
    n ([Char]
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. a -> [a]
    repeat Char
    ' ')

    zipDefault :: a -> b -> [a] -> [b] -> [(a, b)]
    zipDefault :: forall a b. a -> b -> [a] -> [b] -> [(a, b)]
    zipDefault a
    _ b
    _ [] [] = []
    zipDefault a
    _ b
    bd (a
    a : [a]
    as) [] = (a
    a, b
    bd) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : (a -> (a, b)) -> [a] -> [(a, b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,b
    bd) [a]
    as
    zipDefault a
    ad b
    _ [] (b
    b : [b]
    bs) = (a
    ad, b
    b) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : (b -> (a, b)) -> [b] -> [(a, b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (a
    ad,) [b]
    bs
    zipDefault a
    ad b
    bd (a
    a : [a]
    as) (b
    b : [b]
    bs) = (a
    a, b
    b) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : a -> b -> [a] -> [b] -> [(a, b)]
    forall a b. a -> b -> [a] -> [b] -> [(a, b)]
    zipDefault a
    ad b
    bd [a]
    as [b]
    bs

    -- | Pretty printing of short options.
    -- * With required arguments can be given as:
    --    @-w PATH or -wPATH (but not -w=PATH)@
    --   This is dislayed as:
    --    @-w PATH or -wPATH@
    -- * With optional but default arguments can be given as:
    --    @-j or -jNUM (but not -j=NUM or -j NUM)@
    --   This is dislayed as:
    --    @-j[NUM]@
    fmtShort :: ArgDescr a -> Char -> String
    fmtShort :: forall a. ArgDescr a -> Char -> [Char]
    fmtShort (NoArg a
    _) Char
    so = [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    so]
    fmtShort (ReqArg [Char] -> Either [Char] a
    _ [Char]
    ad) Char
    so =
      let opt :: [Char]
    opt = [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    so]
       in [Char]
    opt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ad [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " or " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    opt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ad
    fmtShort (OptArg [Char]
    _ Maybe [Char] -> Either [Char] a
    _ [Char]
    ad) Char
    so =
      let opt :: [Char]
    opt = [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    so]
       in [Char]
    opt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "[" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ad [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"

    -- | Pretty printing of long options.
    -- * With required arguments can be given as:
    --    @--with-compiler=PATH (but not --with-compiler PATH)@
    --   This is dislayed as:
    --    @--with-compiler=PATH@
    -- * With optional but default arguments can be given as:
    --    @--jobs or --jobs=NUM (but not --jobs NUM)@
    --   This is dislayed as:
    --    @--jobs[=NUM]@
    fmtLong :: ArgDescr a -> String -> String
    fmtLong :: forall a. ArgDescr a -> [Char] -> [Char]
    fmtLong (NoArg a
    _) [Char]
    lo = [Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    lo
    fmtLong (ReqArg [Char] -> Either [Char] a
    _ [Char]
    ad) [Char]
    lo =
      let opt :: [Char]
    opt = [Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    lo
       in [Char]
    opt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ad
    fmtLong (OptArg [Char]
    _ Maybe [Char] -> Either [Char] a
    _ [Char]
    ad) [Char]
    lo =
      let opt :: [Char]
    opt = [Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    lo
       in [Char]
    opt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "[=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ad [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"

    wrapText :: Int -> String -> [String]
    wrapText :: Int -> [Char] -> [[Char]]
    wrapText Int
    width = ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [[Char]] -> [Char]
    unwords ([[[Char]]] -> [[Char]])
    -> ([Char] -> [[[Char]]]) -> [Char] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [[Char]] -> [[Char]] -> [[[Char]]]
    wrap Int
    0 [] ([[Char]] -> [[[Char]]])
    -> ([Char] -> [[Char]]) -> [Char] -> [[[Char]]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [[Char]]
    words
      where
        wrap :: Int -> [String] -> [String] -> [[String]]
        wrap :: Int -> [[Char]] -> [[Char]] -> [[[Char]]]
    wrap Int
    0 [] ([Char]
    w : [[Char]]
    ws)
          | [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    width =
              Int -> [[Char]] -> [[Char]] -> [[[Char]]]
    wrap ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    w) [[Char]
    w] [[Char]]
    ws
        wrap Int
    col [[Char]]
    line ([Char]
    w : [[Char]]
    ws)
          | Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    width =
              [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse [[Char]]
    line [[Char]] -> [[[Char]]] -> [[[Char]]]
    forall a. a -> [a] -> [a]
    : Int -> [[Char]] -> [[Char]] -> [[[Char]]]
    wrap Int
    0 [] ([Char]
    w [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    ws)
        wrap Int
    col [[Char]]
    line ([Char]
    w : [[Char]]
    ws) =
          let col' :: Int
    col' = Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
           in Int -> [[Char]] -> [[Char]] -> [[[Char]]]
    wrap Int
    col' ([Char]
    w [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    line) [[Char]]
    ws
        wrap Int
    _ [] [] = []
        wrap Int
    _ [[Char]]
    line [] = [[[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse [[Char]]
    line]

    -- |
    -- Process the command-line, and return the list of values that matched
    -- (and those that didn\'t). The arguments are:
    --
    -- * The order requirements (see 'ArgOrder')
    --
    -- * The option descriptions (see 'OptDescr')
    --
    -- * The actual command line arguments (presumably got from
    --   'System.Environment.getArgs').
    --
    -- 'getOpt' returns a triple consisting of the option arguments, a list
    -- of non-options, and a list of error messages.
    getOpt
      :: ArgOrder a -- non-option handling
      -> [OptDescr a] -- option descriptors
      -> [String] -- the command-line arguments
      -> ([a], [String], [String]) -- (options,non-options,error messages)
    getOpt :: forall a.
    ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
    getOpt ArgOrder a
    ordering [OptDescr a]
    optDescr [[Char]]
    args = ([a]
    os, [[Char]]
    xs, [[Char]]
    es [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    errUnrec [[Char]]
    us)
      where
        ([a]
    os, [[Char]]
    xs, [[Char]]
    us, [[Char]]
    es) = ArgOrder a
    -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
    forall a.
    ArgOrder a
    -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
    getOpt' ArgOrder a
    ordering [OptDescr a]
    optDescr [[Char]]
    args

    -- |
    -- This is almost the same as 'getOpt', but returns a quadruple
    -- consisting of the option arguments, a list of non-options, a list of
    -- unrecognized options, and a list of error messages.
    getOpt'
      :: ArgOrder a -- non-option handling
      -> [OptDescr a] -- option descriptors
      -> [String] -- the command-line arguments
      -> ([a], [String], [String], [String]) -- (options,non-options,unrecognized,error messages)
    getOpt' :: forall a.
    ArgOrder a
    -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
    getOpt' ArgOrder a
    _ [OptDescr a]
    _ [] = ([], [], [], [])
    getOpt' ArgOrder a
    ordering [OptDescr a]
    optDescr ([Char]
    arg : [[Char]]
    args) = OptKind a -> ArgOrder a -> ([a], [[Char]], [[Char]], [[Char]])
    forall {a}.
    OptKind a -> ArgOrder a -> ([a], [[Char]], [[Char]], [[Char]])
    procNextOpt OptKind a
    opt ArgOrder a
    ordering
      where
        procNextOpt :: OptKind a -> ArgOrder a -> ([a], [[Char]], [[Char]], [[Char]])
    procNextOpt (Opt a
    o) ArgOrder a
    _ = (a
    o a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    os, [[Char]]
    xs, [[Char]]
    us, [[Char]]
    es)
        procNextOpt (UnreqOpt [Char]
    u) ArgOrder a
    _ = ([a]
    os, [[Char]]
    xs, [Char]
    u [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    us, [[Char]]
    es)
        procNextOpt (NonOpt [Char]
    x) ArgOrder a
    RequireOrder = ([], [Char]
    x [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    rest, [], [])
        procNextOpt (NonOpt [Char]
    x) ArgOrder a
    Permute = ([a]
    os, [Char]
    x [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    xs, [[Char]]
    us, [[Char]]
    es)
        procNextOpt OptKind a
    EndOfOpts ArgOrder a
    RequireOrder = ([], [[Char]]
    rest, [], [])
        procNextOpt OptKind a
    EndOfOpts ArgOrder a
    Permute = ([], [[Char]]
    rest, [], [])
        procNextOpt (OptErr [Char]
    e) ArgOrder a
    _ = ([a]
    os, [[Char]]
    xs, [[Char]]
    us, [Char]
    e [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    es)

        (OptKind a
    opt, [[Char]]
    rest) = [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    forall a.
    [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    getNext [Char]
    arg [[Char]]
    args [OptDescr a]
    optDescr
        ([a]
    os, [[Char]]
    xs, [[Char]]
    us, [[Char]]
    es) = ArgOrder a
    -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
    forall a.
    ArgOrder a
    -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
    getOpt' ArgOrder a
    ordering [OptDescr a]
    optDescr [[Char]]
    rest

    -- take a look at the next cmd line arg and decide what to do with it
    getNext :: String -> [String] -> [OptDescr a] -> (OptKind a, [String])
    getNext :: forall a.
    [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    getNext (Char
    '-' : Char
    '-' : []) [[Char]]
    rest [OptDescr a]
    _ = (OptKind a
    forall a. OptKind a
    EndOfOpts, [[Char]]
    rest)
    getNext (Char
    '-' : Char
    '-' : [Char]
    xs) [[Char]]
    rest [OptDescr a]
    optDescr = [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    forall a.
    [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    longOpt [Char]
    xs [[Char]]
    rest [OptDescr a]
    optDescr
    getNext (Char
    '-' : Char
    x : [Char]
    xs) [[Char]]
    rest [OptDescr a]
    optDescr = Char -> [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    forall a.
    Char -> [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    shortOpt Char
    x [Char]
    xs [[Char]]
    rest [OptDescr a]
    optDescr
    getNext [Char]
    a [[Char]]
    rest [OptDescr a]
    _ = ([Char] -> OptKind a
    forall a. [Char] -> OptKind a
    NonOpt [Char]
    a, [[Char]]
    rest)

    -- handle long option
    longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a, [String])
    longOpt :: forall a.
    [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    longOpt [Char]
    ls [[Char]]
    rs [OptDescr a]
    optDescr = [ArgDescr a] -> [Char] -> [[Char]] -> (OptKind a, [[Char]])
    forall {b}.
    [ArgDescr b] -> [Char] -> [[Char]] -> (OptKind b, [[Char]])
    long [ArgDescr a]
    ads [Char]
    arg [[Char]]
    rs
      where
        ([Char]
    opt, [Char]
    arg) = (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') [Char]
    ls
        getWith :: ([Char] -> [Char] -> Bool) -> [OptDescr a]
    getWith [Char] -> [Char] -> Bool
    p =
          [ OptDescr a
    o | o :: OptDescr a
    o@(Option [Char]
    _ [[Char]]
    xs ArgDescr a
    _ [Char]
    _) <- [OptDescr a]
    optDescr, Maybe [Char] -> Bool
    forall a. Maybe a -> Bool
    isJust (([Char] -> Bool) -> [[Char]] -> Maybe [Char]
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ([Char] -> [Char] -> Bool
    p [Char]
    opt) [[Char]]
    xs)
          ]
        exact :: [OptDescr a]
    exact = ([Char] -> [Char] -> Bool) -> [OptDescr a]
    getWith [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)
        options :: [OptDescr a]
    options = if [OptDescr a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [OptDescr a]
    exact then ([Char] -> [Char] -> Bool) -> [OptDescr a]
    getWith [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf else [OptDescr a]
    exact
        ads :: [ArgDescr a]
    ads = [ArgDescr a
    ad | Option [Char]
    _ [[Char]]
    _ ArgDescr a
    ad [Char]
    _ <- [OptDescr a]
    options]
        optStr :: [Char]
    optStr = [Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    opt
        fromRes :: Either [Char] a -> OptKind a
    fromRes = [Char] -> Either [Char] a -> OptKind a
    forall a. [Char] -> Either [Char] a -> OptKind a
    fromParseResult [Char]
    optStr

        long :: [ArgDescr b] -> [Char] -> [[Char]] -> (OptKind b, [[Char]])
    long (ArgDescr b
    _ : ArgDescr b
    _ : [ArgDescr b]
    _) [Char]
    _ [[Char]]
    rest = ([OptDescr a] -> [Char] -> OptKind b
    forall a b. [OptDescr a] -> [Char] -> OptKind b
    errAmbig [OptDescr a]
    options [Char]
    optStr, [[Char]]
    rest)
        long [NoArg b
    a] [] [[Char]]
    rest = (b -> OptKind b
    forall a. a -> OptKind a
    Opt b
    a, [[Char]]
    rest)
        long [NoArg b
    _] (Char
    '=' : [Char]
    _) [[Char]]
    rest = ([Char] -> OptKind b
    forall a. [Char] -> OptKind a
    errNoArg [Char]
    optStr, [[Char]]
    rest)
        long [ReqArg [Char] -> Either [Char] b
    _ [Char]
    d] [] [] = ([Char] -> [Char] -> OptKind b
    forall a. [Char] -> [Char] -> OptKind a
    errReq [Char]
    d [Char]
    optStr, [])
        long [ReqArg [Char] -> Either [Char] b
    f [Char]
    _] [] ([Char]
    r : [[Char]]
    rest) = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes ([Char] -> Either [Char] b
    f [Char]
    r), [[Char]]
    rest)
        long [ReqArg [Char] -> Either [Char] b
    f [Char]
    _] (Char
    '=' : [Char]
    xs) [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes ([Char] -> Either [Char] b
    f [Char]
    xs), [[Char]]
    rest)
        long [OptArg [Char]
    _ Maybe [Char] -> Either [Char] b
    f [Char]
    _] [] [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes (Maybe [Char] -> Either [Char] b
    f Maybe [Char]
    forall a. Maybe a
    Nothing), [[Char]]
    rest)
        long [OptArg [Char]
    _ Maybe [Char] -> Either [Char] b
    f [Char]
    _] (Char
    '=' : [Char]
    xs) [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes (Maybe [Char] -> Either [Char] b
    f ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    xs)), [[Char]]
    rest)
        long [ArgDescr b]
    _ [Char]
    _ [[Char]]
    rest = ([Char] -> OptKind b
    forall a. [Char] -> OptKind a
    UnreqOpt ([Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ls), [[Char]]
    rest)

    -- handle short option
    shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
    shortOpt :: forall a.
    Char -> [Char] -> [[Char]] -> [OptDescr a] -> (OptKind a, [[Char]])
    shortOpt Char
    y [Char]
    ys [[Char]]
    rs [OptDescr a]
    optDescr = [ArgDescr a] -> [Char] -> [[Char]] -> (OptKind a, [[Char]])
    forall {b}.
    [ArgDescr b] -> [Char] -> [[Char]] -> (OptKind b, [[Char]])
    short [ArgDescr a]
    ads [Char]
    ys [[Char]]
    rs
      where
        options :: [OptDescr a]
    options = [OptDescr a
    o | o :: OptDescr a
    o@(Option [Char]
    ss [[Char]]
    _ ArgDescr a
    _ [Char]
    _) <- [OptDescr a]
    optDescr, Char
    s <- [Char]
    ss, Char
    y Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    s]
        ads :: [ArgDescr a]
    ads = [ArgDescr a
    ad | Option [Char]
    _ [[Char]]
    _ ArgDescr a
    ad [Char]
    _ <- [OptDescr a]
    options]
        optStr :: [Char]
    optStr = Char
    '-' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char
    y]
        fromRes :: Either [Char] a -> OptKind a
    fromRes = [Char] -> Either [Char] a -> OptKind a
    forall a. [Char] -> Either [Char] a -> OptKind a
    fromParseResult [Char]
    optStr

        short :: [ArgDescr b] -> [Char] -> [[Char]] -> (OptKind b, [[Char]])
    short (ArgDescr b
    _ : ArgDescr b
    _ : [ArgDescr b]
    _) [Char]
    _ [[Char]]
    rest = ([OptDescr a] -> [Char] -> OptKind b
    forall a b. [OptDescr a] -> [Char] -> OptKind b
    errAmbig [OptDescr a]
    options [Char]
    optStr, [[Char]]
    rest)
        short (NoArg b
    a : [ArgDescr b]
    _) [] [[Char]]
    rest = (b -> OptKind b
    forall a. a -> OptKind a
    Opt b
    a, [[Char]]
    rest)
        short (NoArg b
    a : [ArgDescr b]
    _) [Char]
    xs [[Char]]
    rest = (b -> OptKind b
    forall a. a -> OptKind a
    Opt b
    a, (Char
    '-' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    xs) [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    rest)
        short (ReqArg [Char] -> Either [Char] b
    _ [Char]
    d : [ArgDescr b]
    _) [] [] = ([Char] -> [Char] -> OptKind b
    forall a. [Char] -> [Char] -> OptKind a
    errReq [Char]
    d [Char]
    optStr, [])
        short (ReqArg [Char] -> Either [Char] b
    f [Char]
    _ : [ArgDescr b]
    _) [] ([Char]
    r : [[Char]]
    rest) = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes ([Char] -> Either [Char] b
    f [Char]
    r), [[Char]]
    rest)
        short (ReqArg [Char] -> Either [Char] b
    f [Char]
    _ : [ArgDescr b]
    _) [Char]
    xs [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes ([Char] -> Either [Char] b
    f [Char]
    xs), [[Char]]
    rest)
        short (OptArg [Char]
    _ Maybe [Char] -> Either [Char] b
    f [Char]
    _ : [ArgDescr b]
    _) [] [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes (Maybe [Char] -> Either [Char] b
    f Maybe [Char]
    forall a. Maybe a
    Nothing), [[Char]]
    rest)
        short (OptArg [Char]
    _ Maybe [Char] -> Either [Char] b
    f [Char]
    _ : [ArgDescr b]
    _) [Char]
    xs [[Char]]
    rest = (Either [Char] b -> OptKind b
    forall {a}. Either [Char] a -> OptKind a
    fromRes (Maybe [Char] -> Either [Char] b
    f ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    xs)), [[Char]]
    rest)
        short [] [] [[Char]]
    rest = ([Char] -> OptKind b
    forall a. [Char] -> OptKind a
    UnreqOpt [Char]
    optStr, [[Char]]
    rest)
        short [] [Char]
    xs [[Char]]
    rest = ([Char] -> OptKind b
    forall a. [Char] -> OptKind a
    UnreqOpt ([Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    xs), [[Char]]
    rest)

    -- This is different vs upstream = (UnreqOpt optStr,('-':xs):rest)
    -- Apparently this was part of the change so that flags that are
    -- not recognised as global flags are passed on to the sub-command.
    -- But why was no equivalent change required for longOpt? So could
    -- this change go upstream?

    fromParseResult :: String -> Either String a -> OptKind a
    fromParseResult :: forall a. [Char] -> Either [Char] a -> OptKind a
    fromParseResult [Char]
    optStr Either [Char] a
    res = case Either [Char] a
    res of
      Right a
    x -> a -> OptKind a
    forall a. a -> OptKind a
    Opt a
    x
      Left [Char]
    err -> [Char] -> OptKind a
    forall a. [Char] -> OptKind a
    OptErr ([Char]
    "invalid argument to option `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "': " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n")

    -- miscellaneous error formatting

    errAmbig :: [OptDescr a] -> String -> OptKind b
    errAmbig :: forall a b. [OptDescr a] -> [Char] -> OptKind b
    errAmbig [OptDescr a]
    ods [Char]
    optStr = [Char] -> OptKind b
    forall a. [Char] -> OptKind a
    OptErr ([Char] -> [OptDescr a] -> [Char]
    forall a. [Char] -> [OptDescr a] -> [Char]
    usageInfo [Char]
    header [OptDescr a]
    ods)
      where
        header :: [Char]
    header = [Char]
    "option `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "' is ambiguous; could be one of:"

    errReq :: String -> String -> OptKind a
    errReq :: forall a. [Char] -> [Char] -> OptKind a
    errReq [Char]
    d [Char]
    optStr = [Char] -> OptKind a
    forall a. [Char] -> OptKind a
    OptErr ([Char]
    "option `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "' requires an argument " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    d [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n")

    errUnrec :: String -> String
    errUnrec :: [Char] -> [Char]
    errUnrec [Char]
    optStr = [Char]
    "unrecognized option `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'\n"

    errNoArg :: String -> OptKind a
    errNoArg :: forall a. [Char] -> OptKind a
    errNoArg [Char]
    optStr = [Char] -> OptKind a
    forall a. [Char] -> OptKind a
    OptErr ([Char]
    "option `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    optStr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "' doesn't allow an argument\n")