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
flatten :: Pattern a -> Pattern a
flatten :: 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 :: [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 :: [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 :: String -> String
trimEmptyLines String
s = String -> String
trimmed String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
where
isNewline :: Char -> Bool
isNewline = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
trimmed :: String -> String
trimmed = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isNewline (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isNewline
pLine :: CharParser OptInfoMap OptPattern
pLine :: CharParser OptInfoMap OptPattern
pLine = OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap OptPattern
pSeq CharParser OptInfoMap OptPattern
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity [OptPattern]
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 String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity Char
forall u. CharParser u Char
pipe)
where pSeq :: CharParser OptInfoMap OptPattern
pSeq = [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Sequence ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser OptInfoMap OptPattern
pExp CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity [OptPattern]
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 OptPattern
pExpSeq = OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Sequence ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser OptInfoMap OptPattern
pExp CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity [OptPattern]
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 String OptInfoMap Identity [OptPattern]
pOptGroup = Char
-> CharParser OptInfoMap OptPattern
-> Char
-> ParsecT String OptInfoMap Identity [OptPattern]
forall u a. Char -> CharParser u a -> Char -> CharParser u [a]
pGroup Char
'[' CharParser OptInfoMap OptPattern
pExpSeq Char
']'
pReqGroup :: CharParser OptInfoMap [OptPattern]
pReqGroup :: ParsecT String OptInfoMap Identity [OptPattern]
pReqGroup = Char
-> CharParser OptInfoMap OptPattern
-> Char
-> ParsecT String OptInfoMap Identity [OptPattern]
forall u a. Char -> CharParser u a -> Char -> CharParser u [a]
pGroup Char
'(' CharParser OptInfoMap OptPattern
pExpSeq Char
')'
saveOptionsExpectVal :: (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal :: (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 (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 :: Bool
expectsVal = Bool
optExpectsVal Bool -> Bool -> Bool
|| OptionInfo -> Bool
expectsVal OptionInfo
oldinfo}
Maybe OptionInfo
Nothing -> ([Option] -> OptionInfo
fromSynList [Option
opt]) {expectsVal :: Bool
expectsVal = Bool
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 String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
Char
ch <- ParsecT String 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 (m :: * -> *) a. Monad m => a -> m a
return (Char
ch, Bool
expectsVal)
pStackedShortOption :: CharParser OptInfoMap OptPattern
pStackedShortOption :: CharParser OptInfoMap OptPattern
pStackedShortOption = CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern)
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
String
chars <- ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
Bool
lastExpectsVal <- CharParser OptInfoMap Bool
pOptionArgument
let (String
firstChars, Char
lastChar) = (String -> String
forall a. [a] -> [a]
init String
chars, String -> Char
forall a. [a] -> a
last String
chars)
firstPairs :: [(Char, Bool)]
firstPairs = (Char -> (Char, Bool)) -> String -> [(Char, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> (Char
x,Bool
False)) String
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 String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
chars of
Int
0 -> String -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
Int
1 -> OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern -> CharParser OptInfoMap OptPattern)
-> OptPattern -> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ Option -> OptPattern
forall a. a -> Pattern a
Atom (Option -> OptPattern) -> (Char -> Option) -> Char -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Option
ShortOption (Char -> OptPattern) -> Char -> OptPattern
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
chars
Int
_ -> OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern -> CharParser OptInfoMap OptPattern)
-> OptPattern -> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (Char -> OptPattern) -> String -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> OptPattern
forall a. a -> Pattern a
Atom (Option -> OptPattern) -> (Char -> Option) -> Char -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Option
ShortOption) String
chars
pLongOption :: CharParser OptInfoMap (Name, Bool)
pLongOption :: CharParser OptInfoMap (String, Bool)
pLongOption = CharParser OptInfoMap (String, Bool)
-> CharParser OptInfoMap (String, Bool)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap (String, Bool)
-> CharParser OptInfoMap (String, Bool))
-> CharParser OptInfoMap (String, Bool)
-> CharParser OptInfoMap (String, Bool)
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--"
String
name <- ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String)
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
alphanumerics
Bool
expectsVal <- CharParser OptInfoMap Bool
pOptionArgument
(String, Bool) -> CharParser OptInfoMap (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, Bool
expectsVal)
pAnyOption :: CharParser OptInfoMap String
pAnyOption :: ParsecT String OptInfoMap Identity String
pAnyOption = ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"options")
pOptionArgument :: CharParser OptInfoMap Bool
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 String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Char -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=') ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String OptInfoMap Identity Char
forall u. CharParser u Char
inlineSpace
ParsecT String 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 String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String OptInfoMap Identity String
pArgument ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String)
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
alphanumerics)
Bool -> CharParser OptInfoMap Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
pArgument :: CharParser OptInfoMap String
pArgument :: ParsecT String OptInfoMap Identity String
pArgument = ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String OptInfoMap Identity String
forall u. ParsecT String u Identity String
bracketStyle ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String OptInfoMap Identity String
forall u. ParsecT String u Identity String
upperStyle
where bracketStyle :: ParsecT String u Identity String
bracketStyle = do
Char
open <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
String
name <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String u Identity Char
-> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
alphanumSpecial
Char
close <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
upperStyle :: ParsecT String u Identity String
upperStyle = do
Char
first <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
uppers
String
rest <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String u Identity Char
-> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String -> ParsecT String u Identity Char)
-> String -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ String
uppers String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
numerics
String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ Char
firstChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest
pCommand :: CharParser OptInfoMap String
pCommand :: ParsecT String OptInfoMap Identity String
pCommand = ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
alphanumerics)
repeatable :: CharParser OptInfoMap OptPattern -> CharParser OptInfoMap OptPattern
repeatable :: CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
repeatable CharParser OptInfoMap OptPattern
p = do
OptPattern
expct <- CharParser OptInfoMap OptPattern
p
OptPattern -> OptPattern
tryRepeat <- (ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String 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 String OptInfoMap Identity Char
forall u. CharParser u Char
inlineSpace CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity String
forall u. ParsecT String u Identity String
ellipsis) ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (OptPattern -> OptPattern)
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Repeated) ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (OptPattern -> OptPattern)
-> ParsecT String OptInfoMap Identity (OptPattern -> OptPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return OptPattern -> OptPattern
forall a. a -> a
id
OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern -> OptPattern
tryRepeat OptPattern
expct)
pExp :: CharParser OptInfoMap OptPattern
pExp :: CharParser OptInfoMap OptPattern
pExp = CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces CharParser OptInfoMap ()
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
repeatable CharParser OptInfoMap OptPattern
value
where value :: CharParser OptInfoMap OptPattern
value = [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
flatOneOf ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String OptInfoMap Identity [OptPattern]
pReqGroup
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Sequence ([OptPattern] -> OptPattern)
-> ([OptPattern] -> [OptPattern]) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String OptInfoMap Identity [OptPattern]
-> ParsecT String OptInfoMap Identity [OptPattern]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String
-> String
-> CharParser OptInfoMap OptPattern
-> ParsecT String OptInfoMap Identity [OptPattern]
forall u a. String -> String -> CharParser u a -> CharParser u [a]
betweenS String
"[" String
"]" CharParser OptInfoMap OptPattern
pExp)
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern)
-> ParsecT String OptInfoMap Identity [OptPattern]
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String OptInfoMap Identity [OptPattern]
pOptGroup
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Option -> OptPattern
forall a. a -> Pattern a
Atom Option
AnyOption) CharParser OptInfoMap OptPattern
-> ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String OptInfoMap Identity String
pAnyOption
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser OptInfoMap OptPattern
pStackedShortOption
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do (String
name, Bool
expectsVal) <- CharParser OptInfoMap (String, Bool)
pLongOption
(String -> Option) -> [(String, Bool)] -> CharParser OptInfoMap ()
forall a. (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()
saveOptionsExpectVal String -> Option
LongOption [(String
name, Bool
expectsVal)]
OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern -> CharParser OptInfoMap OptPattern)
-> OptPattern -> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ Option -> OptPattern
forall a. a -> Pattern a
Atom (Option -> OptPattern) -> Option -> OptPattern
forall a b. (a -> b) -> a -> b
$ String -> Option
LongOption String
name
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Option -> OptPattern
forall a. a -> Pattern a
Atom (Option -> OptPattern)
-> (String -> Option) -> String -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Option
Argument (String -> OptPattern)
-> ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String OptInfoMap Identity String
pArgument
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Option -> OptPattern
forall a. a -> Pattern a
Atom (Option -> OptPattern)
-> (String -> Option) -> String -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Option
Command (String -> OptPattern)
-> ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap OptPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String OptInfoMap Identity String
pCommand
pUsageHeader :: CharParser OptInfoMap String
= String -> ParsecT String OptInfoMap Identity String
forall u. String -> CharParser u String
caseInsensitive String
"Usage:"
pUsageLine :: CharParser OptInfoMap OptPattern
pUsageLine :: CharParser OptInfoMap OptPattern
pUsageLine =
CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern)
-> CharParser OptInfoMap OptPattern
-> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ do
CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String 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))
CharParser OptInfoMap OptPattern
pLine
pUsagePatterns :: CharParser OptInfoMap OptPattern
pUsagePatterns :: CharParser OptInfoMap OptPattern
pUsagePatterns = do
ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String OptInfoMap Identity String
-> 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 String OptInfoMap Identity String
pUsageHeader CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
ParsecT String OptInfoMap Identity String
pUsageHeader
CharParser OptInfoMap ()
forall u. CharParser u ()
optionalEndline
[OptPattern]
usageLines <- CharParser OptInfoMap OptPattern
pUsageLine CharParser OptInfoMap OptPattern
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity [OptPattern]
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 String OptInfoMap Identity Char
forall u. CharParser u Char
endline
OptPattern -> CharParser OptInfoMap OptPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern -> CharParser OptInfoMap OptPattern)
-> OptPattern -> CharParser OptInfoMap OptPattern
forall a b. (a -> b) -> a -> b
$ OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ [OptPattern]
usageLines
begOptionLine :: CharParser OptInfoMap String
begOptionLine :: ParsecT String OptInfoMap Identity String
begOptionLine = CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity Char
-> ParsecT String 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 String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-"
pOptSynonyms :: CharParser OptInfoMap ([Option], Bool)
pOptSynonyms :: CharParser OptInfoMap ([Option], Bool)
pOptSynonyms = do CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
[(Option, Bool)]
pairs <- ParsecT String OptInfoMap Identity (Option, Bool)
p ParsecT String OptInfoMap Identity (Option, Bool)
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String 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 String 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 String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String 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 (m :: * -> *) a. Monad m => a -> m a
return ([Option]
options, Bool
expectsVal)
where p :: ParsecT String 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 String OptInfoMap Identity (Option, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap (Char, Bool)
pShortOption
ParsecT String OptInfoMap Identity (Option, Bool)
-> ParsecT String OptInfoMap Identity (Option, Bool)
-> ParsecT String OptInfoMap Identity (Option, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (\(String
s, Bool
ev) -> (String -> Option
LongOption String
s, Bool
ev)) ((String, Bool) -> (Option, Bool))
-> CharParser OptInfoMap (String, Bool)
-> ParsecT String OptInfoMap Identity (Option, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptInfoMap (String, Bool)
pLongOption
pDefaultTag :: CharParser OptInfoMap String
pDefaultTag :: ParsecT String OptInfoMap Identity String
pDefaultTag = do
String -> ParsecT String OptInfoMap Identity String
forall u. String -> CharParser u String
caseInsensitive String
"[default:"
CharParser OptInfoMap ()
forall u. CharParser u ()
inlineSpaces
String
def <- ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"]")
Char -> ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
String -> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
def
pOptDefault :: CharParser OptInfoMap (Maybe String)
pOptDefault :: CharParser OptInfoMap (Maybe String)
pOptDefault = do
ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT String OptInfoMap Identity String
pDefaultTag ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity String
begOptionLine))
ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String OptInfoMap Identity String
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 String
def <- CharParser OptInfoMap (Maybe String)
pOptDefault
ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity String
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 :: Maybe String
defaultVal = Maybe String
def, expectsVal :: Bool
expectsVal = Bool
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
pOptDescriptions :: CharParser OptInfoMap OptInfoMap
pOptDescriptions :: CharParser OptInfoMap OptInfoMap
pOptDescriptions = do
ParsecT String OptInfoMap Identity String
-> CharParser OptInfoMap ()
forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil (ParsecT String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT String OptInfoMap Identity Char
-> ParsecT String OptInfoMap Identity String
-> ParsecT String OptInfoMap Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptInfoMap Identity String
begOptionLine)
ParsecT String 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 String OptInfoMap Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
ParsecT String 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 String OptInfoMap Identity [()]
-> CharParser OptInfoMap ())
-> ParsecT String OptInfoMap Identity [()]
-> CharParser OptInfoMap ()
forall a b. (a -> b) -> a -> b
$ CharParser OptInfoMap ()
pOptDescription CharParser OptInfoMap ()
-> ParsecT String OptInfoMap Identity Char
-> ParsecT String 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 String OptInfoMap Identity Char
forall u. CharParser u Char
endline
CharParser OptInfoMap OptInfoMap
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
pDocopt :: CharParser OptInfoMap OptFormat
pDocopt :: CharParser OptInfoMap OptFormat
pDocopt = do
OptPattern
optPattern <- CharParser OptInfoMap OptPattern
pUsagePatterns
OptInfoMap
optInfoMap <- CharParser OptInfoMap OptInfoMap
pOptDescriptions
let optPattern' :: OptPattern
optPattern' = OptPattern -> OptPattern
eagerSort (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
optInfoMap OptPattern
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 :: Bool
isRepeated = Pattern a -> a -> Bool
forall a. Eq a => Pattern a -> a -> Bool
canRepeat Pattern a
pat a
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 :: Bool
isRepeated = Pattern a -> a -> Bool
forall a. Eq a => Pattern a -> a -> Bool
canRepeat Pattern a
pat a
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 (OptPattern -> Option -> Maybe OptionInfo -> Maybe OptionInfo
forall a.
Eq a =>
Pattern a -> a -> Maybe OptionInfo -> Maybe OptionInfo
saveCanRepeat OptPattern
optPattern') (OptPattern -> [Option]
forall a. Eq a => Pattern a -> [a]
atoms OptPattern
optPattern') OptInfoMap
optInfoMap
OptFormat -> CharParser OptInfoMap OptFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (OptPattern
optPattern', OptInfoMap
optInfoMap')
expectSynonyms :: OptInfoMap -> OptPattern -> OptPattern
expectSynonyms :: OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim (Sequence [OptPattern]
exs) = [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Sequence ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim) [OptPattern]
exs
expectSynonyms OptInfoMap
oim (OneOf [OptPattern]
exs) = [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim) [OptPattern]
exs
expectSynonyms OptInfoMap
oim (Unordered [OptPattern]
exs) = [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map (OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim) [OptPattern]
exs
expectSynonyms OptInfoMap
oim (Optional OptPattern
ex) = OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim OptPattern
ex
expectSynonyms OptInfoMap
oim (Repeated OptPattern
ex) = OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Repeated (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> OptPattern -> OptPattern
expectSynonyms OptInfoMap
oim OptPattern
ex
expectSynonyms OptInfoMap
oim a :: OptPattern
a@(Atom Option
atom) = case Option
atom of
e :: Option
e@(Command String
ex) -> OptPattern
a
e :: Option
e@(Argument String
ex) -> OptPattern
a
e :: Option
e@Option
AnyOption -> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> [OptPattern]
forall a. Eq a => [a] -> [a]
nub ([OptPattern] -> [OptPattern]) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> a -> b
$ (Option -> OptPattern) -> [Option] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map Option -> OptPattern
forall a. a -> Pattern a
Atom ([Option] -> [OptPattern]) -> [Option] -> [OptPattern]
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 String
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 -> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (Option -> OptPattern) -> [Option] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map Option -> OptPattern
forall a. a -> Pattern a
Atom [Option]
syns
Maybe [Option]
Nothing -> OptPattern
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 -> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
flatten (OptPattern -> OptPattern)
-> ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (Option -> OptPattern) -> [Option] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map Option -> OptPattern
forall a. a -> Pattern a
Atom [Option]
syns
Maybe [Option]
Nothing -> OptPattern
a
canRepeat :: Eq a => Pattern a -> a -> Bool
canRepeat :: 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 (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 (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
compareOptSpecificity :: Option -> Option -> Ordering
compareOptSpecificity :: Option -> Option -> Ordering
compareOptSpecificity Option
optA Option
optB = case Option
optA of
LongOption String
a -> case Option
optB of
LongOption String
b -> (String -> Int) -> String -> String -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a String
b
Option
_ -> Ordering
GT
ShortOption Char
a -> case Option
optB of
LongOption String
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 String
a -> case Option
optB of
LongOption String
b -> Ordering
LT
ShortOption Char
b -> Ordering
LT
Command String
b -> (String -> Int) -> String -> String -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a String
b
Option
_ -> Ordering
GT
Argument String
a -> case Option
optB of
Option
AnyOption -> Ordering
GT
Argument String
b -> (String -> Int) -> String -> String -> Ordering
forall a b. (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering
comparingFirst String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a String
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 :: (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
eagerSort :: OptPattern -> OptPattern
eagerSort :: OptPattern -> OptPattern
eagerSort OptPattern
pat = case OptPattern
pat of
OneOf [OptPattern]
ps -> [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> OptPattern
innerSort [OptPattern]
ps
OptPattern
a -> OptPattern -> OptPattern
innerSort OptPattern
a
where
innerSort :: OptPattern -> OptPattern
innerSort OptPattern
ipat = case OptPattern
ipat of
Sequence [OptPattern]
ps -> [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Sequence ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> OptPattern
innerSort [OptPattern]
ps
OneOf [OptPattern]
ps -> [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> OptPattern
innerSort
([OptPattern] -> [OptPattern])
-> ([OptPattern] -> [OptPattern]) -> [OptPattern] -> [OptPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptPattern -> OptPattern -> Ordering)
-> [OptPattern] -> [OptPattern]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((OptPattern -> Down Int) -> OptPattern -> OptPattern -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((OptPattern -> Down Int) -> OptPattern -> OptPattern -> Ordering)
-> (OptPattern -> Down Int) -> OptPattern -> OptPattern -> Ordering
forall a b. (a -> b) -> a -> b
$ Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int) -> (OptPattern -> Int) -> OptPattern -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptPattern -> Int
maxLength)
([OptPattern] -> [OptPattern])
-> ([OptPattern] -> [OptPattern]) -> [OptPattern] -> [OptPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptPattern -> OptPattern -> Ordering)
-> [OptPattern] -> [OptPattern]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((OptPattern -> Option) -> OptPattern -> OptPattern -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing OptPattern -> Option
representativeAtom)
([OptPattern] -> [OptPattern]) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> a -> b
$ [OptPattern]
ps
Unordered [OptPattern]
ps -> [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered ([OptPattern] -> OptPattern) -> [OptPattern] -> OptPattern
forall a b. (a -> b) -> a -> b
$ (OptPattern -> OptPattern) -> [OptPattern] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> OptPattern
innerSort [OptPattern]
ps
Optional OptPattern
p -> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ OptPattern -> OptPattern
innerSort OptPattern
p
Repeated OptPattern
p -> OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Repeated (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ OptPattern -> OptPattern
innerSort OptPattern
p
a :: OptPattern
a@(Atom Option
_) -> OptPattern
a
representativeAtom :: OptPattern -> Option
representativeAtom :: OptPattern -> Option
representativeAtom OptPattern
p = case OptPattern
p of
Sequence [OptPattern]
ps -> if [OptPattern] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptPattern]
ps then Option
AnyOption else OptPattern -> Option
representativeAtom (OptPattern -> Option) -> OptPattern -> Option
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> OptPattern
forall a. [a] -> a
head [OptPattern]
ps
OneOf [OptPattern]
ps -> (Option -> Option -> Ordering) -> [Option] -> Option
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Option -> Option -> Ordering
compareOptSpecificity ([Option] -> Option)
-> ([OptPattern] -> [Option]) -> [OptPattern] -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptPattern -> Option) -> [OptPattern] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> Option
representativeAtom ([OptPattern] -> Option) -> [OptPattern] -> Option
forall a b. (a -> b) -> a -> b
$ [OptPattern]
ps
Unordered [OptPattern]
ps -> (Option -> Option -> Ordering) -> [Option] -> Option
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Option -> Option -> Ordering
compareOptSpecificity ([Option] -> Option)
-> ([OptPattern] -> [Option]) -> [OptPattern] -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptPattern -> Option) -> [OptPattern] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> Option
representativeAtom ([OptPattern] -> Option) -> [OptPattern] -> Option
forall a b. (a -> b) -> a -> b
$ [OptPattern]
ps
Optional OptPattern
p -> OptPattern -> Option
representativeAtom OptPattern
p
Repeated OptPattern
p -> OptPattern -> Option
representativeAtom OptPattern
p
Atom Option
a -> Option
a
maxLength :: OptPattern -> Int
maxLength :: OptPattern -> Int
maxLength OptPattern
p = case OptPattern
p of
Sequence [OptPattern]
ps -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (OptPattern -> Int) -> [OptPattern] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> Int
maxLength [OptPattern]
ps
OneOf [OptPattern]
ps -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (OptPattern -> Int) -> [OptPattern] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> Int
maxLength [OptPattern]
ps
Unordered [OptPattern]
ps -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (OptPattern -> Int) -> [OptPattern] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map OptPattern -> Int
maxLength [OptPattern]
ps
Optional OptPattern
p -> OptPattern -> Int
maxLength OptPattern
p
Repeated OptPattern
p -> OptPattern -> Int
maxLength OptPattern
p
Atom Option
a -> case Option
a of
LongOption String
o -> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
o
ShortOption Char
_ -> Int
1
Command String
c -> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
Argument String
a -> Int
100
Option
AnyOption -> Int
0