-----------------------------------------------------------------------------
-- |
-- 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.
--
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NamedFieldPuns #-}
module Distribution.GetOpt (
   -- * GetOpt
   getOpt, getOpt',
   usageInfo,
   ArgOrder(..),
   OptDescr(..),
   ArgDescr(..),

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

import Prelude ()
import Distribution.Compat.Prelude

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

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
   = NoArg                   a                       -- ^   no argument expected
   | ReqArg (String       -> Either String a) String -- ^   option requires argument
   | OptArg (Maybe String -> Either String a) String -- ^   optional argument

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 Maybe [Char] -> Either [Char] a
g [Char]
s) = (Maybe [Char] -> Either [Char] b) -> [Char] -> ArgDescr b
forall a. (Maybe [Char] -> Either [Char] a) -> [Char] -> ArgDescr a
OptArg ((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{[Char]
optNames :: OptHelp -> [Char]
optNames :: [Char]
optNames, [Char]
optHelp :: OptHelp -> [Char]
optHelp :: [Char]
optHelp} <- [OptHelp]
options
      let wrappedHelp :: [[Char]]
wrappedHelp = Int -> [Char] -> [[Char]]
wrapText Int
descolWidth [Char]
optHelp
      if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
optNames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxOptNameWidth
        then [[Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
optNames] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
             [[Char]] -> [[Char]] -> [[Char]]
renderColumns [] [[Char]]
wrappedHelp
        else [[Char]] -> [[Char]] -> [[Char]]
renderColumns [[Char]
optNames] [[Char]]
wrappedHelp

    renderColumns :: [String] -> [String] -> [String]
    renderColumns :: [[Char]] -> [[Char]] -> [[Char]]
renderColumns [[Char]]
xs [[Char]]
ys = do
      ([Char]
x, [Char]
y) <- [Char] -> [Char] -> [[Char]] -> [[Char]] -> [([Char], [Char])]
forall a b. a -> b -> [a] -> [b] -> [(a, b)]
zipDefault [Char]
"" [Char]
"" [[Char]]
xs [[Char]]
ys
      [Char] -> [[Char]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padTo Int
maxOptNameWidth [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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

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]
_) Char
so = [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
so]
fmtShort (OptArg Maybe [Char] -> Either [Char] a
_  [Char]
_) Char
so = [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
so]
  -- unlike upstream GetOpt we omit the arg name for short options

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 = [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ad
fmtLong (OptArg Maybe [Char] -> Either [Char] a
_ [Char]
ad) [Char]
lo = [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lo [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
oa -> [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 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 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 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 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")