{-# OPTIONS_GHC -Wno-unused-do-bind #-}

module System.Console.Docopt.UsageParse
  where

import qualified Data.Map as M
import           Data.Ord (comparing)
import           GHC.Exts (Down(..))
import           Data.List (nub, sortBy, maximumBy, dropWhileEnd)

import System.Console.Docopt.ParseUtils
import System.Console.Docopt.Types

-- * Helpers

-- | Flattens the top level of a Pattern, as long as that
--   /does not/ alter the matching semantics of the Pattern
flatten :: Pattern a -> Pattern a
flatten :: forall a. Pattern a -> Pattern a
flatten (Sequence (Pattern a
x:[]))  = Pattern a
x
flatten (OneOf (Pattern a
x:[]))     = Pattern a
x
flatten (Unordered (Pattern a
x:[])) = Pattern a
x
flatten Pattern a
x                  = Pattern a
x

flatSequence :: [Pattern a] -> Pattern a
flatSequence :: forall a. [Pattern a] -> Pattern a
flatSequence = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
flatten (Pattern a -> Pattern a)
-> ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
Sequence

flatOneOf :: [Pattern a] -> Pattern a
flatOneOf :: forall a. [Pattern a] -> Pattern a
flatOneOf = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
flatten (Pattern a -> Pattern a)
-> ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
OneOf

trimEmptyLines :: String -> String
trimEmptyLines :: [Char] -> [Char]
trimEmptyLines [Char]
s = [Char] -> [Char]
trimmed [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
  where
    isNewline :: Char -> Bool
isNewline = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
    trimmed :: [Char] -> [Char]
trimmed = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isNewline ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isNewline


-- * Pattern Parsers

pLine :: CharParser OptInfoMap OptPattern
pLine :: CharParser OptInfoMap (Pattern Option)
pLine = Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap (Pattern Option)
pSeq CharParser OptInfoMap (Pattern Option)
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` (CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
pipe)
        where pSeq :: CharParser OptInfoMap (Pattern Option)
pSeq = [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Sequence ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser OptInfoMap (Pattern Option)
pExp CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces1)

pExpSeq :: CharParser OptInfoMap OptPattern
pExpSeq :: CharParser OptInfoMap (Pattern Option)
pExpSeq = Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Sequence ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser OptInfoMap (Pattern Option)
pExp CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy1` CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces1)

pOptGroup :: CharParser OptInfoMap [OptPattern]
pOptGroup :: ParsecT [Char] OptInfoMap Identity [Pattern Option]
pOptGroup = Char
-> CharParser OptInfoMap (Pattern Option)
-> Char
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall u a. Char -> CharParser u a -> Char -> CharParser u [a]
pGroup Char
'[' CharParser OptInfoMap (Pattern Option)
pExpSeq Char
']'

pReqGroup :: CharParser OptInfoMap [OptPattern]
pReqGroup :: ParsecT [Char] OptInfoMap Identity [Pattern Option]
pReqGroup = Char
-> CharParser OptInfoMap (Pattern Option)
-> Char
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall u a. Char -> CharParser u a -> Char -> CharParser u [a]
pGroup Char
'(' CharParser OptInfoMap (Pattern Option)
pExpSeq Char
')'

saveOptionsExpectVal :: (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal :: forall a. (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal a -> Option
t [(a, Bool)]
pairs = (OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ())
-> (OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ()
forall a b. (a -> b) -> a -> b
$ \OptInfoMap
st -> (OptInfoMap -> (a, Bool) -> OptInfoMap)
-> OptInfoMap -> [(a, Bool)] -> OptInfoMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OptInfoMap -> (a, Bool) -> OptInfoMap
save OptInfoMap
st [(a, Bool)]
pairs
    where save :: OptInfoMap -> (a, Bool) -> OptInfoMap
save OptInfoMap
infomap (a
name, Bool
optExpectsVal) = (Maybe OptionInfo -> Maybe OptionInfo)
-> Option -> OptInfoMap -> OptInfoMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe OptionInfo -> Maybe OptionInfo
alterFn Option
opt OptInfoMap
infomap
            where opt :: Option
opt = a -> Option
t a
name
                  alterFn :: Maybe OptionInfo -> Maybe OptionInfo
alterFn Maybe OptionInfo
oldval = OptionInfo -> Maybe OptionInfo
forall a. a -> Maybe a
Just (OptionInfo -> Maybe OptionInfo) -> OptionInfo -> Maybe OptionInfo
forall a b. (a -> b) -> a -> b
$ case Maybe OptionInfo
oldval of
                    Just OptionInfo
oldinfo -> OptionInfo
oldinfo {expectsVal = optExpectsVal || expectsVal oldinfo}
                    Maybe OptionInfo
Nothing -> ([Option] -> OptionInfo
fromSynList [Option
opt]) {expectsVal = optExpectsVal}


pShortOption :: CharParser OptInfoMap (Char, Bool)
pShortOption :: CharParser OptInfoMap (Char, Bool)
pShortOption = CharParser OptInfoMap (Char, Bool)
-> CharParser OptInfoMap (Char, Bool)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap (Char, Bool)
 -> CharParser OptInfoMap (Char, Bool))
-> CharParser OptInfoMap (Char, Bool)
-> CharParser OptInfoMap (Char, Bool)
forall a b. (a -> b) -> a -> b
$ do Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
                        Char
ch <- ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
                        Bool
expectsVal <- CharParser OptInfoMap Bool
pOptionArgument
                        (Char, Bool) -> CharParser OptInfoMap (Char, Bool)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
ch, Bool
expectsVal)

pStackedShortOption :: CharParser OptInfoMap OptPattern
pStackedShortOption :: CharParser OptInfoMap (Pattern Option)
pStackedShortOption = CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap (Pattern Option)
 -> CharParser OptInfoMap (Pattern Option))
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ do
    Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
    [Char]
chars <- ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
    Bool
lastExpectsVal <- CharParser OptInfoMap Bool
pOptionArgument
    let ([Char]
firstChars, Char
lastChar) = ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
chars, [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
chars)
        firstPairs :: [(Char, Bool)]
firstPairs = (Char -> (Char, Bool)) -> [Char] -> [(Char, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> (Char
x,Bool
False)) [Char]
firstChars
        lastPair :: (Char, Bool)
lastPair = (Char
lastChar, Bool
lastExpectsVal)
    (Char -> Option) -> [(Char, Bool)] -> CharParser OptInfoMap ()
forall a. (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal Char -> Option
ShortOption ([(Char, Bool)]
firstPairs [(Char, Bool)] -> [(Char, Bool)] -> [(Char, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Char, Bool)
lastPair])
    case [Char]
chars of
      []  -> [Char] -> CharParser OptInfoMap (Pattern Option)
forall a. [Char] -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
""
      [Char
c] -> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option -> CharParser OptInfoMap (Pattern Option))
-> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ Option -> Pattern Option
forall a. a -> Pattern a
Atom (Option -> Pattern Option)
-> (Char -> Option) -> Char -> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Option
ShortOption (Char -> Pattern Option) -> Char -> Pattern Option
forall a b. (a -> b) -> a -> b
$ Char
c
      [Char]
_ -> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option -> CharParser OptInfoMap (Pattern Option))
-> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Unordered ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Char -> Pattern Option) -> [Char] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> Pattern Option
forall a. a -> Pattern a
Atom (Option -> Pattern Option)
-> (Char -> Option) -> Char -> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Option
ShortOption) [Char]
chars

pLongOption :: CharParser OptInfoMap (Name, Bool)
pLongOption :: CharParser OptInfoMap ([Char], Bool)
pLongOption = CharParser OptInfoMap ([Char], Bool)
-> CharParser OptInfoMap ([Char], Bool)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap ([Char], Bool)
 -> CharParser OptInfoMap ([Char], Bool))
-> CharParser OptInfoMap ([Char], Bool)
-> CharParser OptInfoMap ([Char], Bool)
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"--"
    [Char]
name <- ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] OptInfoMap Identity Char
 -> ParsecT [Char] OptInfoMap Identity [Char])
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
alphanumerics
    Bool
expectsVal <- CharParser OptInfoMap Bool
pOptionArgument
    --let expectsVal = False
    ([Char], Bool) -> CharParser OptInfoMap ([Char], Bool)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
name, Bool
expectsVal)

pAnyOption :: CharParser OptInfoMap String
pAnyOption :: ParsecT [Char] OptInfoMap Identity [Char]
pAnyOption = ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"options")

pOptionArgument :: CharParser OptInfoMap Bool -- True if one is encountered, else False
pOptionArgument :: CharParser OptInfoMap Bool
pOptionArgument = Bool -> CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool)
-> CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool
forall a b. (a -> b) -> a -> b
$ CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool)
-> CharParser OptInfoMap Bool -> CharParser OptInfoMap Bool
forall a b. (a -> b) -> a -> b
$ do
    ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=') ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
inlineSpace
    ParsecT [Char] OptInfoMap Identity Char -> CharParser OptInfoMap ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] OptInfoMap Identity [Char]
pArgument ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] OptInfoMap Identity Char
 -> ParsecT [Char] OptInfoMap Identity [Char])
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
alphanumerics)
    Bool -> CharParser OptInfoMap Bool
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

pArgument :: CharParser OptInfoMap String
pArgument :: ParsecT [Char] OptInfoMap Identity [Char]
pArgument = ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] OptInfoMap Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
bracketStyle ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] OptInfoMap Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
upperStyle
            where bracketStyle :: ParsecT [Char] u Identity [Char]
bracketStyle = do
                      Char
_open <- Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
                      [Char]
name <- ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall a.
ParsecT [Char] u Identity a -> ParsecT [Char] u Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT [Char] u Identity Char
 -> ParsecT [Char] u Identity [Char])
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
alphanumSpecial
                      Char
_close <- Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
                      [Char] -> ParsecT [Char] u Identity [Char]
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name
                  upperStyle :: ParsecT [Char] u Identity [Char]
upperStyle = do
                      Char
first <- [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
uppers
                      [Char]
rest <- ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall a.
ParsecT [Char] u Identity a -> ParsecT [Char] u Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT [Char] u Identity Char
 -> ParsecT [Char] u Identity [Char])
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf ([Char] -> ParsecT [Char] u Identity Char)
-> [Char] -> ParsecT [Char] u Identity Char
forall a b. (a -> b) -> a -> b
$ [Char]
uppers [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
numerics
                      [Char] -> ParsecT [Char] u Identity [Char]
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] u Identity [Char])
-> [Char] -> ParsecT [Char] u Identity [Char]
forall a b. (a -> b) -> a -> b
$ Char
firstChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest

pCommand :: CharParser OptInfoMap String
pCommand :: ParsecT [Char] OptInfoMap Identity [Char]
pCommand = ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
alphanumerics)

-- '<arg>...' make an OptPattern Repeated if followed by ellipsis
repeatable :: CharParser OptInfoMap OptPattern -> CharParser OptInfoMap OptPattern
repeatable :: CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
repeatable CharParser OptInfoMap (Pattern Option)
p = do
    Pattern Option
expct <- CharParser OptInfoMap (Pattern Option)
p
    Pattern Option -> Pattern Option
tryRepeat <- (ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] OptInfoMap Identity Char -> CharParser OptInfoMap ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
inlineSpace CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
ellipsis) ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pattern Option -> Pattern Option)
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Repeated) ParsecT
  [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Pattern Option -> Pattern Option)
-> ParsecT
     [Char] OptInfoMap Identity (Pattern Option -> Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern Option -> Pattern Option
forall a. a -> a
id
    Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option -> Pattern Option
tryRepeat Pattern Option
expct)

pExp :: CharParser OptInfoMap OptPattern
pExp :: CharParser OptInfoMap (Pattern Option)
pExp = CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces CharParser OptInfoMap ()
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
repeatable CharParser OptInfoMap (Pattern Option)
value
     where value :: CharParser OptInfoMap (Pattern Option)
value = [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
flatOneOf ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] OptInfoMap Identity [Pattern Option]
pReqGroup
               -- <|> Optional . flatten . OneOf <$> betweenS "[(" ")]" pLine
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Sequence ([Pattern Option] -> Pattern Option)
-> ([Pattern Option] -> [Pattern Option])
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Optional ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char]
-> [Char]
-> CharParser OptInfoMap (Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall u a. [Char] -> [Char] -> CharParser u a -> CharParser u [a]
betweenS [Char]
"[" [Char]
"]" CharParser OptInfoMap (Pattern Option)
pExp)
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Optional (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] OptInfoMap Identity [Pattern Option]
pOptGroup
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Option -> Pattern Option
forall a. a -> Pattern a
Atom Option
AnyOption) CharParser OptInfoMap (Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap (Pattern Option)
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] OptInfoMap Identity [Char]
pAnyOption
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser OptInfoMap (Pattern Option)
pStackedShortOption
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do ([Char]
name, Bool
expectsVal) <- CharParser OptInfoMap ([Char], Bool)
pLongOption
                      ([Char] -> Option) -> [([Char], Bool)] -> CharParser OptInfoMap ()
forall a. (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal [Char] -> Option
LongOption [([Char]
name, Bool
expectsVal)]
                      Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option -> CharParser OptInfoMap (Pattern Option))
-> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ Option -> Pattern Option
forall a. a -> Pattern a
Atom (Option -> Pattern Option) -> Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ [Char] -> Option
LongOption [Char]
name
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Option -> Pattern Option
forall a. a -> Pattern a
Atom (Option -> Pattern Option)
-> ([Char] -> Option) -> [Char] -> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Option
Argument ([Char] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] OptInfoMap Identity [Char]
pArgument
               CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Option -> Pattern Option
forall a. a -> Pattern a
Atom (Option -> Pattern Option)
-> ([Char] -> Option) -> [Char] -> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Option
Command ([Char] -> Pattern Option)
-> ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap (Pattern Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] OptInfoMap Identity [Char]
pCommand


-- * Usage Pattern Parsers

pUsageHeader :: CharParser OptInfoMap String
pUsageHeader :: ParsecT [Char] OptInfoMap Identity [Char]
pUsageHeader = [Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall u. [Char] -> CharParser u [Char]
caseInsensitive [Char]
"Usage:"

-- | Ignores leading spaces and first word, then parses
--   the rest of the usage line
pUsageLine :: CharParser OptInfoMap OptPattern
pUsageLine :: CharParser OptInfoMap (Pattern Option)
pUsageLine =
    CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap (Pattern Option)
 -> CharParser OptInfoMap (Pattern Option))
-> CharParser OptInfoMap (Pattern Option)
-> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ do
        CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
        ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) -- prog name
        CharParser OptInfoMap (Pattern Option)
pLine

pUsagePatterns :: CharParser OptInfoMap OptPattern
pUsagePatterns :: CharParser OptInfoMap (Pattern Option)
pUsagePatterns = do
        ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Char] OptInfoMap Identity [Char]
pUsageHeader CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
        ParsecT [Char] OptInfoMap Identity [Char]
pUsageHeader
        CharParser OptInfoMap ()
forall u. CharParser u ()
optionalEndline
        [Pattern Option]
usageLines <- CharParser OptInfoMap (Pattern Option)
pUsageLine CharParser OptInfoMap (Pattern Option)
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Pattern Option]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
endline
        Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option -> CharParser OptInfoMap (Pattern Option))
-> Pattern Option -> CharParser OptInfoMap (Pattern Option)
forall a b. (a -> b) -> a -> b
$ Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ [Pattern Option]
usageLines

-- * Option Synonyms & Defaults Parsers

-- | Succeeds only on the first line of an option explanation
--   (one whose first non-space character is @\'-\'@)
begOptionLine :: CharParser OptInfoMap String
begOptionLine :: ParsecT [Char] OptInfoMap Identity [Char]
begOptionLine = CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"-"

pOptSynonyms :: CharParser OptInfoMap ([Option], Bool)
pOptSynonyms :: CharParser OptInfoMap ([Option], Bool)
pOptSynonyms = do CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
                  [(Option, Bool)]
pairs <- ParsecT [Char] OptInfoMap Identity (Option, Bool)
p ParsecT [Char] OptInfoMap Identity (Option, Bool)
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [(Option, Bool)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy1` (ParsecT [Char] OptInfoMap Identity Char -> CharParser OptInfoMap ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity Char
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
inlineSpace)
                  let options :: [Option]
options = ((Option, Bool) -> Option) -> [(Option, Bool)] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (Option, Bool) -> Option
forall a b. (a, b) -> a
fst [(Option, Bool)]
pairs
                      expectsVal :: Bool
expectsVal = ((Option, Bool) -> Bool) -> [(Option, Bool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Option, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Option, Bool)]
pairs
                  ([Option], Bool) -> CharParser OptInfoMap ([Option], Bool)
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option]
options, Bool
expectsVal)
               where p :: ParsecT [Char] OptInfoMap Identity (Option, Bool)
p =   (\(Char
c, Bool
ev) -> (Char -> Option
ShortOption Char
c, Bool
ev)) ((Char, Bool) -> (Option, Bool))
-> CharParser OptInfoMap (Char, Bool)
-> ParsecT [Char] OptInfoMap Identity (Option, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap (Char, Bool)
pShortOption
                       ParsecT [Char] OptInfoMap Identity (Option, Bool)
-> ParsecT [Char] OptInfoMap Identity (Option, Bool)
-> ParsecT [Char] OptInfoMap Identity (Option, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (\([Char]
s, Bool
ev) -> ([Char] -> Option
LongOption [Char]
s, Bool
ev)) (([Char], Bool) -> (Option, Bool))
-> CharParser OptInfoMap ([Char], Bool)
-> ParsecT [Char] OptInfoMap Identity (Option, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap ([Char], Bool)
pLongOption

pDefaultTag :: CharParser OptInfoMap String
pDefaultTag :: ParsecT [Char] OptInfoMap Identity [Char]
pDefaultTag = do
    [Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall u. [Char] -> CharParser u [Char]
caseInsensitive [Char]
"[default:"
    CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
    [Char]
def <- ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Char] -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]")
    Char -> ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
    [Char] -> ParsecT [Char] OptInfoMap Identity [Char]
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
def

pOptDefault :: CharParser OptInfoMap (Maybe String)
pOptDefault :: CharParser OptInfoMap (Maybe [Char])
pOptDefault = do
    ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT [Char] OptInfoMap Identity [Char]
pDefaultTag ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity [Char]
begOptionLine))
    ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap (Maybe [Char])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] OptInfoMap Identity [Char]
pDefaultTag

pOptDescription :: CharParser OptInfoMap ()
pOptDescription :: CharParser OptInfoMap ()
pOptDescription = CharParser OptInfoMap () -> CharParser OptInfoMap ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap () -> CharParser OptInfoMap ())
-> CharParser OptInfoMap () -> CharParser OptInfoMap ()
forall a b. (a -> b) -> a -> b
$ do
    ([Option]
syns, Bool
expectsVal) <- CharParser OptInfoMap ([Option], Bool)
pOptSynonyms
    Maybe [Char]
def <- CharParser OptInfoMap (Maybe [Char])
pOptDefault
    ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity [Char]
begOptionLine)
    (OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ())
-> (OptInfoMap -> OptInfoMap) -> CharParser OptInfoMap ()
forall a b. (a -> b) -> a -> b
$ \OptInfoMap
infomap ->
      let optinfo :: OptionInfo
optinfo = ([Option] -> OptionInfo
fromSynList [Option]
syns) {defaultVal = def, expectsVal = expectsVal}
          saveOptInfo :: Map k OptionInfo -> k -> Map k OptionInfo
saveOptInfo Map k OptionInfo
infomap k
expct = k -> OptionInfo -> Map k OptionInfo -> Map k OptionInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
expct OptionInfo
optinfo Map k OptionInfo
infomap
      in  (OptInfoMap -> Option -> OptInfoMap)
-> OptInfoMap -> [Option] -> OptInfoMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OptInfoMap -> Option -> OptInfoMap
forall {k}. Ord k => Map k OptionInfo -> k -> Map k OptionInfo
saveOptInfo OptInfoMap
infomap [Option]
syns
    () -> CharParser OptInfoMap ()
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pOptDescriptions :: CharParser OptInfoMap OptInfoMap
pOptDescriptions :: CharParser OptInfoMap OptInfoMap
pOptDescriptions = do
    ParsecT [Char] OptInfoMap Identity [Char]
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [Char]
-> ParsecT [Char] OptInfoMap Identity [Char]
forall a b.
ParsecT [Char] OptInfoMap Identity a
-> ParsecT [Char] OptInfoMap Identity b
-> ParsecT [Char] OptInfoMap Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptInfoMap Identity [Char]
begOptionLine)
    ParsecT [Char] OptInfoMap Identity Char -> CharParser OptInfoMap ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Char] OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    ParsecT [Char] OptInfoMap Identity [()] -> CharParser OptInfoMap ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Char] OptInfoMap Identity [()]
 -> CharParser OptInfoMap ())
-> ParsecT [Char] OptInfoMap Identity [()]
-> CharParser OptInfoMap ()
forall a b. (a -> b) -> a -> b
$ CharParser OptInfoMap ()
pOptDescription CharParser OptInfoMap ()
-> ParsecT [Char] OptInfoMap Identity Char
-> ParsecT [Char] OptInfoMap Identity [()]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` ParsecT [Char] OptInfoMap Identity Char
forall u. CharParser u Char
endline
    CharParser OptInfoMap OptInfoMap
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState


-- | Main usage parser: parses all of the usage lines into an Exception,
--   and all of the option descriptions along with any accompanying
--   defaults, and returns both in a tuple
pDocopt :: CharParser OptInfoMap OptFormat
pDocopt :: CharParser OptInfoMap OptFormat
pDocopt = do
    Pattern Option
optPattern <- CharParser OptInfoMap (Pattern Option)
pUsagePatterns
    OptInfoMap
optInfoMap <- CharParser OptInfoMap OptInfoMap
pOptDescriptions
    let optPattern' :: Pattern Option
optPattern' = Pattern Option -> Pattern Option
eagerSort (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
optInfoMap Pattern Option
optPattern
        saveCanRepeat :: Pattern a -> a -> Maybe OptionInfo -> Maybe OptionInfo
saveCanRepeat Pattern a
pat a
el Maybe OptionInfo
minfo = case Maybe OptionInfo
minfo of
          (Just OptionInfo
info) -> OptionInfo -> Maybe OptionInfo
forall a. a -> Maybe a
Just (OptionInfo -> Maybe OptionInfo) -> OptionInfo -> Maybe OptionInfo
forall a b. (a -> b) -> a -> b
$ OptionInfo
info {isRepeated = canRepeat pat el}
          (Maybe OptionInfo
Nothing)   -> OptionInfo -> Maybe OptionInfo
forall a. a -> Maybe a
Just (OptionInfo -> Maybe OptionInfo) -> OptionInfo -> Maybe OptionInfo
forall a b. (a -> b) -> a -> b
$ ([Option] -> OptionInfo
fromSynList []) {isRepeated = canRepeat pat el}
        optInfoMap' :: OptInfoMap
optInfoMap' = (Option -> Maybe OptionInfo -> Maybe OptionInfo)
-> [Option] -> OptInfoMap -> OptInfoMap
forall k a.
Ord k =>
(k -> Maybe a -> Maybe a) -> [k] -> Map k a -> Map k a
alterAllWithKey (Pattern Option -> Option -> Maybe OptionInfo -> Maybe OptionInfo
forall {a}.
Eq a =>
Pattern a -> a -> Maybe OptionInfo -> Maybe OptionInfo
saveCanRepeat Pattern Option
optPattern') (Pattern Option -> [Option]
forall a. Eq a => Pattern a -> [a]
atoms Pattern Option
optPattern') OptInfoMap
optInfoMap
    OptFormat -> CharParser OptInfoMap OptFormat
forall a. a -> ParsecT [Char] OptInfoMap Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Option
optPattern', OptInfoMap
optInfoMap')


-- ** Pattern transformation & analysis

expectSynonyms :: OptInfoMap -> OptPattern -> OptPattern
expectSynonyms :: OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim (Sequence [Pattern Option]
exs)  = [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Sequence ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim) [Pattern Option]
exs
expectSynonyms OptInfoMap
oim (OneOf [Pattern Option]
exs)     = [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim) [Pattern Option]
exs
expectSynonyms OptInfoMap
oim (Unordered [Pattern Option]
exs) = [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Unordered ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim) [Pattern Option]
exs
expectSynonyms OptInfoMap
oim (Optional Pattern Option
ex)   = Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Optional (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim Pattern Option
ex
expectSynonyms OptInfoMap
oim (Repeated Pattern Option
ex)   = Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Repeated (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> Pattern Option -> Pattern Option
expectSynonyms OptInfoMap
oim Pattern Option
ex
expectSynonyms OptInfoMap
oim a :: Pattern Option
a@(Atom Option
atom)   =
  case Option
atom of
    Command [Char]
_ex      -> Pattern Option
a
    Argument [Char]
_ex     -> Pattern Option
a
    Option
AnyOption        -> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Unordered ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ [Pattern Option] -> [Pattern Option]
forall a. Eq a => [a] -> [a]
nub ([Pattern Option] -> [Pattern Option])
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> a -> b
$ (Option -> Pattern Option) -> [Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Option -> Pattern Option
forall a. a -> Pattern a
Atom ([Option] -> [Pattern Option]) -> [Option] -> [Pattern Option]
forall a b. (a -> b) -> a -> b
$ (OptionInfo -> [Option]) -> [OptionInfo] -> [Option]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptionInfo -> [Option]
synonyms (OptInfoMap -> [OptionInfo]
forall k a. Map k a -> [a]
M.elems OptInfoMap
oim)
    e :: Option
e@(LongOption [Char]
_ex) ->
        case OptionInfo -> [Option]
synonyms (OptionInfo -> [Option]) -> Maybe OptionInfo -> Maybe [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option
e Option -> OptInfoMap -> Maybe OptionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` OptInfoMap
oim of
          Just [Option]
syns -> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Option -> Pattern Option) -> [Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Option -> Pattern Option
forall a. a -> Pattern a
Atom [Option]
syns
          Maybe [Option]
Nothing -> Pattern Option
a
    e :: Option
e@(ShortOption Char
_c) ->
        case OptionInfo -> [Option]
synonyms (OptionInfo -> [Option]) -> Maybe OptionInfo -> Maybe [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option
e Option -> OptInfoMap -> Maybe OptionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` OptInfoMap
oim of
          Just [Option]
syns -> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
flatten (Pattern Option -> Pattern Option)
-> ([Pattern Option] -> Pattern Option)
-> [Pattern Option]
-> Pattern Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Option -> Pattern Option) -> [Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Option -> Pattern Option
forall a. a -> Pattern a
Atom [Option]
syns
          Maybe [Option]
Nothing -> Pattern Option
a

canRepeat :: Eq a => Pattern a -> a -> Bool
canRepeat :: forall a. Eq a => Pattern a -> a -> Bool
canRepeat Pattern a
pat a
target =
  case Pattern a
pat of
    (Sequence [Pattern a]
ps)  -> [Pattern a] -> Bool
canRepeatInside [Pattern a]
ps Bool -> Bool -> Bool
|| ([Pattern a] -> Int
atomicOccurrences [Pattern a]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
    (OneOf [Pattern a]
ps)     -> [Pattern a] -> Bool
canRepeatInside [Pattern a]
ps
    (Unordered [Pattern a]
ps) -> [Pattern a] -> Bool
canRepeatInside [Pattern a]
ps Bool -> Bool -> Bool
|| ([Pattern a] -> Int
atomicOccurrences [Pattern a]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
    (Optional Pattern a
p)   -> Pattern a -> a -> Bool
forall a. Eq a => Pattern a -> a -> Bool
canRepeat Pattern a
p a
target
    (Repeated Pattern a
_p)  -> a
target a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms Pattern a
pat
    (Atom a
_a)      -> Bool
False
  where canRepeatInside :: [Pattern a] -> Bool
canRepeatInside = (Pattern a -> Bool) -> [Pattern a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern a -> a -> Bool
forall a. Eq a => Pattern a -> a -> Bool
`canRepeat` a
target)
        atomicOccurrences :: [Pattern a] -> Int
atomicOccurrences [Pattern a]
ps = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
target) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms (Pattern a -> [a]) -> Pattern a -> [a]
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
Sequence [Pattern a]
ps


-- | Compare on specificity of parsers built from optA and optB,
--   so we can be sure the parser tries the most-specific first, where possible.
--   E.g.
--
-- @
-- LongOption "option" > ShortOption \'o\' == True
-- Command "cmd" > Argument "arg"        == True
-- @
compareOptSpecificity :: Option -> Option -> Ordering
compareOptSpecificity :: Option -> Option -> Ordering
compareOptSpecificity Option
optA Option
optB = case Option
optA of
    LongOption [Char]
a  -> case Option
optB of
      LongOption [Char]
b  -> ([Char] -> Int) -> [Char] -> [Char] -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
a [Char]
b
      Option
_             -> Ordering
GT
    ShortOption Char
a -> case Option
optB of
      LongOption [Char]
_b -> Ordering
LT
      ShortOption Char
b -> Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
a Char
b
      Option
_             -> Ordering
GT
    Command [Char]
a     -> case Option
optB of
      LongOption [Char]
_b  -> Ordering
LT
      ShortOption Char
_b -> Ordering
LT
      Command [Char]
b      -> ([Char] -> Int) -> [Char] -> [Char] -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
a [Char]
b
      Option
_              -> Ordering
GT
    Argument [Char]
a    -> case Option
optB of
      Option
AnyOption     -> Ordering
GT
      Argument [Char]
b    -> ([Char] -> Int) -> [Char] -> [Char] -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
a [Char]
b
      Option
_             -> Ordering
LT
    Option
AnyOption     -> case Option
optB of
      Option
AnyOption     -> Ordering
EQ
      Option
_             -> Ordering
LT
  where
    comparingFirst :: (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
    comparingFirst :: forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst a -> b
p a
a1 a
a2 =
      case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> b
p a
a1) (a -> b
p a
a2) of
        Ordering
EQ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a1 a
a2
        Ordering
o  -> Ordering
o

-- | Sort an OptPattern such that more-specific patterns come first,
--   while leaving the semantics of the pattern structure unchanged.
eagerSort :: OptPattern -> OptPattern
eagerSort :: Pattern Option -> Pattern Option
eagerSort Pattern Option
pat = case Pattern Option
pat of
    -- We special-case a top-level `OneOf` here because that's how
    -- the list of individual pattern lines are represented, and we
    -- never want to reorder those. This is inelegant, but effective
    -- enough for now.
    OneOf [Pattern Option]
ps -> [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Pattern Option
innerSort [Pattern Option]
ps
    Pattern Option
a -> Pattern Option -> Pattern Option
innerSort Pattern Option
a
  where
    innerSort :: Pattern Option -> Pattern Option
innerSort Pattern Option
ipat = case Pattern Option
ipat of
      Sequence [Pattern Option]
ps  -> [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Sequence ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Pattern Option
innerSort [Pattern Option]
ps
      OneOf [Pattern Option]
ps     -> [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
OneOf ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$   (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Pattern Option
innerSort
                              ([Pattern Option] -> [Pattern Option])
-> ([Pattern Option] -> [Pattern Option])
-> [Pattern Option]
-> [Pattern Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Option -> Pattern Option -> Ordering)
-> [Pattern Option] -> [Pattern Option]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Pattern Option -> Down Int)
-> Pattern Option -> Pattern Option -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Pattern Option -> Down Int)
 -> Pattern Option -> Pattern Option -> Ordering)
-> (Pattern Option -> Down Int)
-> Pattern Option
-> Pattern Option
-> Ordering
forall a b. (a -> b) -> a -> b
$ Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> (Pattern Option -> Int) -> Pattern Option -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Option -> Int
maxLength)
                              ([Pattern Option] -> [Pattern Option])
-> ([Pattern Option] -> [Pattern Option])
-> [Pattern Option]
-> [Pattern Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Option -> Pattern Option -> Ordering)
-> [Pattern Option] -> [Pattern Option]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Pattern Option -> Option)
-> Pattern Option -> Pattern Option -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Pattern Option -> Option
representativeAtom)
                              ([Pattern Option] -> [Pattern Option])
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> a -> b
$ [Pattern Option]
ps
      Unordered [Pattern Option]
ps -> [Pattern Option] -> Pattern Option
forall a. [Pattern a] -> Pattern a
Unordered ([Pattern Option] -> Pattern Option)
-> [Pattern Option] -> Pattern Option
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Pattern Option)
-> [Pattern Option] -> [Pattern Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Pattern Option
innerSort [Pattern Option]
ps
      Optional Pattern Option
p   -> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Optional (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ Pattern Option -> Pattern Option
innerSort Pattern Option
p
      Repeated Pattern Option
p   -> Pattern Option -> Pattern Option
forall a. Pattern a -> Pattern a
Repeated (Pattern Option -> Pattern Option)
-> Pattern Option -> Pattern Option
forall a b. (a -> b) -> a -> b
$ Pattern Option -> Pattern Option
innerSort Pattern Option
p
      a :: Pattern Option
a@(Atom Option
_)   -> Pattern Option
a

    representativeAtom :: OptPattern -> Option
    representativeAtom :: Pattern Option -> Option
representativeAtom Pattern Option
p = case Pattern Option
p of
      Sequence []    -> Option
AnyOption
      Sequence (Pattern Option
p:[Pattern Option]
_) -> Pattern Option -> Option
representativeAtom Pattern Option
p
      OneOf [Pattern Option]
ps       -> (Option -> Option -> Ordering) -> [Option] -> Option
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Option -> Option -> Ordering
compareOptSpecificity ([Option] -> Option)
-> ([Pattern Option] -> [Option]) -> [Pattern Option] -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Option -> Option) -> [Pattern Option] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Option
representativeAtom ([Pattern Option] -> Option) -> [Pattern Option] -> Option
forall a b. (a -> b) -> a -> b
$ [Pattern Option]
ps
      Unordered [Pattern Option]
ps   -> (Option -> Option -> Ordering) -> [Option] -> Option
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Option -> Option -> Ordering
compareOptSpecificity ([Option] -> Option)
-> ([Pattern Option] -> [Option]) -> [Pattern Option] -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Option -> Option) -> [Pattern Option] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Option
representativeAtom ([Pattern Option] -> Option) -> [Pattern Option] -> Option
forall a b. (a -> b) -> a -> b
$ [Pattern Option]
ps
      Optional Pattern Option
p     -> Pattern Option -> Option
representativeAtom Pattern Option
p
      Repeated Pattern Option
p     -> Pattern Option -> Option
representativeAtom Pattern Option
p
      Atom Option
a         -> Option
a

    maxLength :: OptPattern -> Int
    maxLength :: Pattern Option -> Int
maxLength Pattern Option
p = case Pattern Option
p of
      Sequence [Pattern Option]
ps  -> [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Int) -> [Pattern Option] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Int
maxLength [Pattern Option]
ps
      OneOf [Pattern Option]
ps     -> [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Int) -> [Pattern Option] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Int
maxLength [Pattern Option]
ps
      Unordered [Pattern Option]
ps -> [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Pattern Option -> Int) -> [Pattern Option] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Option -> Int
maxLength [Pattern Option]
ps
      Optional Pattern Option
p   -> Pattern Option -> Int
maxLength Pattern Option
p
      Repeated Pattern Option
p   -> Pattern Option -> Int
maxLength Pattern Option
p
      Atom Option
a       -> case Option
a of
        LongOption [Char]
o  -> [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
o
        ShortOption Char
_ -> Int
1
        Command [Char]
c     -> [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
c
        Argument [Char]
_a   -> Int
100
        Option
AnyOption     -> Int
0