module System.Console.Docopt.OptParse
where
import Control.Monad (unless)
import qualified Data.Map as M
import Data.List (intercalate, nub, (\\))
import System.Console.Docopt.ParseUtils
import System.Console.Docopt.Types
buildOptParser :: String -> OptFormat -> CharParser OptParserState ()
buildOptParser :: String -> OptFormat -> CharParser OptParserState ()
buildOptParser String
delim fmt :: OptFormat
fmt@(OptPattern
pattern, OptInfoMap
infomap) =
let
argDelim :: ParsecT String u Identity String
argDelim = (ParsecT String u Identity String
-> ParsecT String u Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity String
-> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
delim) ParsecT String u Identity String
-> String -> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"space between arguments"
makeParser :: OptPattern -> CharParser OptParserState ()
makeParser OptPattern
p = String -> OptFormat -> CharParser OptParserState ()
buildOptParser String
delim (OptPattern
p, OptInfoMap
infomap)
argDelimIfNotInShortOptStack :: CharParser OptParserState ()
argDelimIfNotInShortOptStack = do
OptParserState
st <- ParsecT String OptParserState Identity OptParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OptParserState -> Bool
inShortOptStack OptParserState
st
then ParsecT String OptParserState Identity String
-> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim
else () -> CharParser OptParserState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateOptWith :: (Option -> OptionInfo -> String -> Arguments -> Arguments) ->
Option ->
String ->
CharParser OptParserState ()
updateOptWith :: (Option -> OptionInfo -> String -> Arguments -> Arguments)
-> Option -> String -> CharParser OptParserState ()
updateOptWith Option -> OptionInfo -> String -> Arguments -> Arguments
updateFn Option
opt String
val = do
OptParserState
st <- ParsecT String OptParserState Identity OptParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let optInfo :: OptionInfo
optInfo = (OptParserState -> OptInfoMap
optInfoMap OptParserState
st) OptInfoMap -> Option -> OptionInfo
forall k a. Ord k => Map k a -> k -> a
M.! Option
opt
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ (Arguments -> Arguments) -> OptParserState -> OptParserState
updateParsedArgs ((Arguments -> Arguments) -> OptParserState -> OptParserState)
-> (Arguments -> Arguments) -> OptParserState -> OptParserState
forall a b. (a -> b) -> a -> b
$ Option -> OptionInfo -> String -> Arguments -> Arguments
updateFn Option
opt OptionInfo
optInfo String
val
updateSt_saveOccurrence :: Option -> String -> CharParser OptParserState ()
updateSt_saveOccurrence Option
opt String
val = (Option -> OptionInfo -> String -> Arguments -> Arguments)
-> Option -> String -> CharParser OptParserState ()
updateOptWith Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence Option
opt String
val
updateSt_assertPresent :: Option -> CharParser OptParserState ()
updateSt_assertPresent Option
opt = (Option -> OptionInfo -> String -> Arguments -> Arguments)
-> Option -> String -> CharParser OptParserState ()
updateOptWith (\Option
opt OptionInfo
info String
_ -> Option -> OptionInfo -> Arguments -> Arguments
assertPresent Option
opt OptionInfo
info) Option
opt String
""
updateSt_inShortOptStack :: Bool -> ParsecT s OptParserState Identity ()
updateSt_inShortOptStack = (OptParserState -> OptParserState)
-> ParsecT s OptParserState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> ParsecT s OptParserState Identity ())
-> (Bool -> OptParserState -> OptParserState)
-> Bool
-> ParsecT s OptParserState Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> OptParserState -> OptParserState
updateInShortOptStack
in case OptPattern
pattern of
(Sequence [OptPattern]
pats) ->
CharParser OptParserState () -> CharParser OptParserState ()
forall (m :: * -> *) s t b.
(Stream s m t, Show t) =>
ParsecT s OptParserState m b -> ParsecT s OptParserState m b
assertTopConsumesAll (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ (CharParser OptParserState ()
-> CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState ()
-> [CharParser OptParserState ()]
-> CharParser OptParserState ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (CharParser OptParserState ()
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b.
ParsecT String OptParserState Identity a
-> ParsecT String OptParserState Identity b
-> ParsecT String OptParserState Identity b
andThen) (() -> CharParser OptParserState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [CharParser OptParserState ()]
ps
where assertTopConsumesAll :: ParsecT s OptParserState m b -> ParsecT s OptParserState m b
assertTopConsumesAll ParsecT s OptParserState m b
p = do
OptParserState
st <- ParsecT s OptParserState m OptParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if OptParserState -> Bool
inTopLevelSequence OptParserState
st
then do
(OptParserState -> OptParserState) -> ParsecT s OptParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> ParsecT s OptParserState m ())
-> (OptParserState -> OptParserState)
-> ParsecT s OptParserState m ()
forall a b. (a -> b) -> a -> b
$ \OptParserState
st -> OptParserState
st {inTopLevelSequence :: Bool
inTopLevelSequence = Bool
False}
ParsecT s OptParserState m b
p ParsecT s OptParserState m b
-> ParsecT s OptParserState m () -> ParsecT s OptParserState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s OptParserState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
else ParsecT s OptParserState m b
p
inner_pats :: [OptFormat]
inner_pats = (\OptPattern
pat -> (OptPattern
pat, OptInfoMap
infomap)) (OptPattern -> OptFormat) -> [OptPattern] -> [OptFormat]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptPattern]
pats
ps :: [CharParser OptParserState ()]
ps = (String -> OptFormat -> CharParser OptParserState ()
buildOptParser String
delim) (OptFormat -> CharParser OptParserState ())
-> [OptFormat] -> [CharParser OptParserState ()]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptFormat]
inner_pats
andThen :: ParsecT String OptParserState Identity a
-> ParsecT String OptParserState Identity b
-> ParsecT String OptParserState Identity b
andThen = \ParsecT String OptParserState Identity a
p1 ParsecT String OptParserState Identity b
p2 -> do
ParsecT String OptParserState Identity a
p1
CharParser OptParserState ()
argDelimIfNotInShortOptStack
ParsecT String OptParserState Identity b
p2
(OneOf [OptPattern]
pats) ->
[CharParser OptParserState ()] -> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([CharParser OptParserState ()] -> CharParser OptParserState ())
-> [CharParser OptParserState ()] -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ (CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> (OptPattern -> CharParser OptParserState ())
-> OptPattern
-> CharParser OptParserState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptPattern -> CharParser OptParserState ()
makeParser) (OptPattern -> CharParser OptParserState ())
-> [OptPattern] -> [CharParser OptParserState ()]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptPattern]
pats
(Unordered [OptPattern]
pats) -> case [OptPattern]
pats of
OptPattern
pat:[] -> OptPattern -> CharParser OptParserState ()
makeParser OptPattern
pat
[OptPattern]
_ -> [CharParser OptParserState ()] -> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([CharParser OptParserState ()] -> CharParser OptParserState ())
-> [CharParser OptParserState ()] -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ ([OptPattern] -> OptPattern -> CharParser OptParserState ()
parseThisThenRest [OptPattern]
pats) (OptPattern -> CharParser OptParserState ())
-> [OptPattern] -> [CharParser OptParserState ()]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptPattern]
pats
where parseThisThenRest :: [OptPattern] -> OptPattern -> CharParser OptParserState ()
parseThisThenRest [OptPattern]
list OptPattern
pat = CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ do
OptPattern -> CharParser OptParserState ()
makeParser OptPattern
pat
let rest :: [OptPattern]
rest = [OptPattern]
list [OptPattern] -> [OptPattern] -> [OptPattern]
forall a. Eq a => [a] -> [a] -> [a]
\\ [OptPattern
pat]
CharParser OptParserState ()
argDelimIfNotInShortOptStack
OptPattern -> CharParser OptParserState ()
makeParser (OptPattern -> CharParser OptParserState ())
-> OptPattern -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered [OptPattern]
rest
(Optional OptPattern
pat) ->
case OptPattern
pat of
Unordered [OptPattern]
ps -> case [OptPattern]
ps of
OptPattern
p:[] -> OptPattern -> CharParser OptParserState ()
makeParser (OptPattern -> CharParser OptParserState ())
-> OptPattern -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional OptPattern
p
[OptPattern]
_ -> CharParser OptParserState () -> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ [CharParser OptParserState ()] -> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([CharParser OptParserState ()] -> CharParser OptParserState ())
-> [CharParser OptParserState ()] -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ ([OptPattern] -> OptPattern -> CharParser OptParserState ()
parseThisThenRest [OptPattern]
ps) (OptPattern -> CharParser OptParserState ())
-> [OptPattern] -> [CharParser OptParserState ()]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptPattern]
ps
where parseThisThenRest :: [OptPattern] -> OptPattern -> CharParser OptParserState ()
parseThisThenRest [OptPattern]
list OptPattern
pat = CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ do
OptPattern -> CharParser OptParserState ()
makeParser OptPattern
pat
let rest :: [OptPattern]
rest = [OptPattern]
list [OptPattern] -> [OptPattern] -> [OptPattern]
forall a. Eq a => [a] -> [a] -> [a]
\\ [OptPattern
pat]
CharParser OptParserState ()
argDelimIfNotInShortOptStack
OptPattern -> CharParser OptParserState ()
makeParser (OptPattern -> CharParser OptParserState ())
-> OptPattern -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ OptPattern -> OptPattern
forall a. Pattern a -> Pattern a
Optional (OptPattern -> OptPattern) -> OptPattern -> OptPattern
forall a b. (a -> b) -> a -> b
$ [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered [OptPattern]
rest
OptPattern
_ -> CharParser OptParserState () -> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ OptPattern -> CharParser OptParserState ()
makeParser OptPattern
pat
(Repeated OptPattern
pat) -> do
case OptPattern
pat of
(Optional OptPattern
p) -> (CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ OptPattern -> CharParser OptParserState ()
makeParser OptPattern
p) CharParser OptParserState ()
-> CharParser OptParserState ()
-> ParsecT String OptParserState 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]
`sepBy` CharParser OptParserState ()
argDelimIfNotInShortOptStack
OptPattern
_ -> (CharParser OptParserState () -> CharParser OptParserState ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ OptPattern -> CharParser OptParserState ()
makeParser OptPattern
pat) CharParser OptParserState ()
-> CharParser OptParserState ()
-> ParsecT String OptParserState 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]
`sepBy1` CharParser OptParserState ()
argDelimIfNotInShortOptStack
() -> CharParser OptParserState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Atom Option
pat) -> case Option
pat of
o :: Option
o@(ShortOption Char
c) ->
do OptParserState
st <- ParsecT String OptParserState Identity OptParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if OptParserState -> Bool
inShortOptStack OptParserState
st then () -> CharParser OptParserState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else Char -> ParsecT String OptParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String OptParserState Identity Char
-> CharParser OptParserState () -> CharParser OptParserState ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CharParser OptParserState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char -> ParsecT String OptParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> OptParserState -> OptParserState
updateInShortOptStack Bool
True
String
val <- if OptionInfo -> Bool
expectsVal (OptionInfo -> Bool) -> OptionInfo -> Bool
forall a b. (a -> b) -> a -> b
$ OptionInfo -> Option -> OptInfoMap -> OptionInfo
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Option] -> OptionInfo
fromSynList []) Option
o OptInfoMap
infomap
then ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String)
-> ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall a b. (a -> b) -> a -> b
$ do
ParsecT String OptParserState Identity String
-> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String OptParserState Identity String
-> CharParser OptParserState ())
-> ParsecT String OptParserState Identity String
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String OptParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"=" ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> OptParserState -> OptParserState
updateInShortOptStack Bool
False
ParsecT String OptParserState Identity Char
-> CharParser OptParserState ()
-> ParsecT String OptParserState Identity String
forall u a b. CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 ParsecT String OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String OptParserState Identity String
-> CharParser OptParserState ()
forall u a. CharParser u a -> CharParser u ()
lookAhead_ ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim CharParser OptParserState ()
-> CharParser OptParserState () -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser OptParserState ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
else do
Bool
stillInShortStack <- ParsecT String OptParserState Identity String
-> CharParser OptParserState Bool
forall a u. Show a => CharParser u a -> CharParser u Bool
isNotFollowedBy ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim
Bool
-> CharParser OptParserState () -> CharParser OptParserState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stillInShortStack (CharParser OptParserState () -> CharParser OptParserState ())
-> CharParser OptParserState () -> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> OptParserState -> OptParserState
updateInShortOptStack Bool
False
String -> ParsecT String OptParserState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Option
-> (Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState
-> OptParserState
withEachSynonym Option
o ((Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState -> OptParserState)
-> (Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState
-> OptParserState
forall a b. (a -> b) -> a -> b
$
\Arguments
pa Option
syn OptionInfo
info -> Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence Option
syn OptionInfo
info String
val Arguments
pa
CharParser OptParserState ()
-> String -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> Option -> String
humanize Option
o
o :: Option
o@(LongOption String
name) ->
do String -> ParsecT String OptParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--"
String -> ParsecT String OptParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
String
val <- if OptionInfo -> Bool
expectsVal (OptionInfo -> Bool) -> OptionInfo -> Bool
forall a b. (a -> b) -> a -> b
$ OptionInfo -> Option -> OptInfoMap -> OptionInfo
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Option] -> OptionInfo
fromSynList []) Option
o OptInfoMap
infomap
then do
String -> ParsecT String OptParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"=" ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim
ParsecT String OptParserState Identity Char
-> CharParser OptParserState ()
-> ParsecT String OptParserState Identity String
forall u a b. CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 ParsecT String OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String OptParserState Identity String
-> CharParser OptParserState ()
forall u a. CharParser u a -> CharParser u ()
lookAhead_ ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim CharParser OptParserState ()
-> CharParser OptParserState () -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser OptParserState ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
else String -> ParsecT String OptParserState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Option
-> (Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState
-> OptParserState
withEachSynonym Option
o ((Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState -> OptParserState)
-> (Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState
-> OptParserState
forall a b. (a -> b) -> a -> b
$
\Arguments
pa Option
syn OptionInfo
info -> Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence Option
syn OptionInfo
info String
val Arguments
pa
(OptParserState -> OptParserState) -> CharParser OptParserState ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OptParserState -> OptParserState)
-> CharParser OptParserState ())
-> (OptParserState -> OptParserState)
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> OptParserState -> OptParserState
updateInShortOptStack Bool
False
CharParser OptParserState ()
-> String -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> Option -> String
humanize Option
o
o :: Option
o@(Option
AnyOption) ->
let synlists :: [[Option]]
synlists = [[Option]] -> [[Option]]
forall a. Eq a => [a] -> [a]
nub ([[Option]] -> [[Option]])
-> ([OptionInfo] -> [[Option]]) -> [OptionInfo] -> [[Option]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptionInfo -> [Option]) -> [OptionInfo] -> [[Option]]
forall a b. (a -> b) -> [a] -> [b]
map OptionInfo -> [Option]
synonyms ([OptionInfo] -> [[Option]]) -> [OptionInfo] -> [[Option]]
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> [OptionInfo]
forall k a. Map k a -> [a]
M.elems OptInfoMap
infomap
oneOfSyns :: [OptPattern]
oneOfSyns = ([Option] -> OptPattern) -> [[Option]] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map (\[Option]
ss -> [OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
OneOf ((Option -> OptPattern) -> [Option] -> [OptPattern]
forall a b. (a -> b) -> [a] -> [b]
map Option -> OptPattern
forall a. a -> Pattern a
Atom [Option]
ss)) [[Option]]
synlists
unorderedSynParser :: CharParser OptParserState ()
unorderedSynParser = String -> OptFormat -> CharParser OptParserState ()
buildOptParser String
delim ([OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered [OptPattern]
oneOfSyns, OptInfoMap
infomap)
in CharParser OptParserState ()
unorderedSynParser
CharParser OptParserState ()
-> String -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> Option -> String
humanize Option
o
o :: Option
o@(Argument String
name) ->
do String
val <- ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String)
-> ParsecT String OptParserState Identity String
-> ParsecT String OptParserState Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String OptParserState Identity Char
-> ParsecT String OptParserState 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 OptParserState Identity String
-> CharParser OptParserState ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String OptParserState Identity String
forall u. ParsecT String u Identity String
argDelim CharParser OptParserState ()
-> ParsecT String OptParserState Identity Char
-> ParsecT String OptParserState Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
Option -> String -> CharParser OptParserState ()
updateSt_saveOccurrence Option
o String
val
Bool -> CharParser OptParserState ()
forall s. Bool -> ParsecT s OptParserState Identity ()
updateSt_inShortOptStack Bool
False
CharParser OptParserState ()
-> String -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> Option -> String
humanize Option
o
o :: Option
o@(Command String
name) ->
do String -> ParsecT String OptParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
Option -> CharParser OptParserState ()
updateSt_assertPresent Option
o
Bool -> CharParser OptParserState ()
forall s. Bool -> ParsecT s OptParserState Identity ()
updateSt_inShortOptStack Bool
False
CharParser OptParserState ()
-> String -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> Option -> String
humanize Option
o
returnState :: CharParser u a -> CharParser u u
returnState :: CharParser u a -> CharParser u u
returnState CharParser u a
p = CharParser u a
p CharParser u a -> CharParser u u -> CharParser u u
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser u u
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
updateInShortOptStack :: Bool -> OptParserState -> OptParserState
updateInShortOptStack :: Bool -> OptParserState -> OptParserState
updateInShortOptStack Bool
b OptParserState
ops = OptParserState
ops {inShortOptStack :: Bool
inShortOptStack = Bool
b}
updateParsedArgs :: (Arguments -> Arguments) -> OptParserState -> OptParserState
updateParsedArgs :: (Arguments -> Arguments) -> OptParserState -> OptParserState
updateParsedArgs Arguments -> Arguments
f OptParserState
st = OptParserState
st {parsedArgs :: Arguments
parsedArgs = Arguments -> Arguments
f (Arguments -> Arguments) -> Arguments -> Arguments
forall a b. (a -> b) -> a -> b
$ OptParserState -> Arguments
parsedArgs OptParserState
st}
saveOccurrence :: Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence :: Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence Option
opt OptionInfo
info String
newval Arguments
argmap = (Maybe ArgValue -> Maybe ArgValue)
-> Option -> Arguments -> Arguments
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe ArgValue -> Maybe ArgValue
updateCurrentVal Option
opt Arguments
argmap
where updateCurrentVal :: Maybe ArgValue -> Maybe ArgValue
updateCurrentVal Maybe ArgValue
m_oldval = case Maybe ArgValue
m_oldval of
Maybe ArgValue
Nothing -> (String
newval String -> ArgValue -> Maybe ArgValue
`updateFrom`) (ArgValue -> Maybe ArgValue) -> Maybe ArgValue -> Maybe ArgValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (OptionInfo -> Option -> Maybe ArgValue
optInitialValue OptionInfo
info Option
opt)
Just ArgValue
oldval -> String
newval String -> ArgValue -> Maybe ArgValue
`updateFrom` ArgValue
oldval
updateFrom :: String -> ArgValue -> Maybe ArgValue
updateFrom String
newval ArgValue
oldval = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ case ArgValue
oldval of
MultiValue [String]
vs -> [String] -> ArgValue
MultiValue ([String] -> ArgValue) -> [String] -> ArgValue
forall a b. (a -> b) -> a -> b
$ String
newval String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
vs
Value String
v -> String -> ArgValue
Value String
newval
ArgValue
NoValue -> String -> ArgValue
Value String
newval
Counted Int
n -> Int -> ArgValue
Counted (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
ArgValue
Present -> ArgValue
Present
ArgValue
NotPresent -> ArgValue
Present
assertPresent :: Option -> OptionInfo -> Arguments -> Arguments
assertPresent :: Option -> OptionInfo -> Arguments -> Arguments
assertPresent Option
opt OptionInfo
info Arguments
argmap = Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence Option
opt OptionInfo
info String
"" Arguments
argmap
withEachSynonym :: Option ->
(Arguments -> Option -> OptionInfo -> Arguments) ->
OptParserState ->
OptParserState
withEachSynonym :: Option
-> (Arguments -> Option -> OptionInfo -> Arguments)
-> OptParserState
-> OptParserState
withEachSynonym Option
opt Arguments -> Option -> OptionInfo -> Arguments
savefn OptParserState
st =
let infomap :: OptInfoMap
infomap = OptParserState -> OptInfoMap
optInfoMap OptParserState
st
args :: Arguments
args = OptParserState -> Arguments
parsedArgs OptParserState
st
syns :: [Option]
syns = OptionInfo -> [Option]
synonyms (OptionInfo -> [Option]) -> OptionInfo -> [Option]
forall a b. (a -> b) -> a -> b
$ OptionInfo -> Option -> OptInfoMap -> OptionInfo
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Option] -> OptionInfo
fromSynList []) Option
opt OptInfoMap
infomap
foldsavefn :: Arguments -> Option -> Arguments
foldsavefn = \Arguments
args Option
opt ->
let info :: OptionInfo
info = OptionInfo -> Option -> OptInfoMap -> OptionInfo
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Option] -> OptionInfo
fromSynList []) Option
opt OptInfoMap
infomap
in Arguments -> Option -> OptionInfo -> Arguments
savefn Arguments
args Option
opt OptionInfo
info
in OptParserState
st {parsedArgs :: Arguments
parsedArgs = (Arguments -> Option -> Arguments)
-> Arguments -> [Option] -> Arguments
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Arguments -> Option -> Arguments
foldsavefn Arguments
args [Option]
syns}
optInitialValue :: OptionInfo -> Option -> Maybe ArgValue
optInitialValue :: OptionInfo -> Option -> Maybe ArgValue
optInitialValue OptionInfo
info Option
opt =
let repeatable :: Bool
repeatable = OptionInfo -> Bool
isRepeated OptionInfo
info
in case Option
opt of
Command String
name -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then Int -> ArgValue
Counted Int
0 else ArgValue
NotPresent
Argument String
name -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then [String] -> ArgValue
MultiValue [] else ArgValue
NoValue
Option
AnyOption -> Maybe ArgValue
forall a. Maybe a
Nothing
Option
_ -> case OptionInfo -> Bool
expectsVal OptionInfo
info of
Bool
True -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then [String] -> ArgValue
MultiValue [] else ArgValue
NoValue
Bool
False -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then Int -> ArgValue
Counted Int
0 else ArgValue
NotPresent
optDefaultValue :: OptionInfo -> Option -> Maybe ArgValue
optDefaultValue :: OptionInfo -> Option -> Maybe ArgValue
optDefaultValue OptionInfo
info Option
opt =
let repeatable :: Bool
repeatable = OptionInfo -> Bool
isRepeated OptionInfo
info
in case Option
opt of
Command String
name -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then Int -> ArgValue
Counted Int
0 else ArgValue
NotPresent
Argument String
name -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then [String] -> ArgValue
MultiValue [] else ArgValue
NoValue
Option
AnyOption -> Maybe ArgValue
forall a. Maybe a
Nothing
Option
_ -> case OptionInfo -> Bool
expectsVal OptionInfo
info of
Bool
True -> case OptionInfo -> Maybe String
defaultVal OptionInfo
info of
Just String
dval -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable
then [String] -> ArgValue
MultiValue ([String] -> ArgValue) -> [String] -> ArgValue
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
dval
else String -> ArgValue
Value String
dval
Maybe String
Nothing -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then [String] -> ArgValue
MultiValue [] else ArgValue
NoValue
Bool
False -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (ArgValue -> Maybe ArgValue) -> ArgValue -> Maybe ArgValue
forall a b. (a -> b) -> a -> b
$ if Bool
repeatable then Int -> ArgValue
Counted Int
0 else ArgValue
NotPresent
getArguments :: OptFormat -> [String] -> Either ParseError Arguments
getArguments :: OptFormat -> [String] -> Either ParseError Arguments
getArguments OptFormat
optfmt [String]
argv =
let (OptPattern
pattern, OptInfoMap
infomap) = OptFormat
optfmt
delim :: String
delim = String
"«»"
argvString :: String
argvString = String
delim String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
`intercalate` [String]
argv
p :: ParsecT String OptParserState Identity Arguments
p = OptParserState -> Arguments
parsedArgs (OptParserState -> Arguments)
-> ParsecT String OptParserState Identity OptParserState
-> ParsecT String OptParserState Identity Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptParserState ()
-> ParsecT String OptParserState Identity OptParserState
forall u a. CharParser u a -> CharParser u u
returnState (String -> OptFormat -> CharParser OptParserState ()
buildOptParser String
delim OptFormat
optfmt)
patAtoms :: [Option]
patAtoms = OptPattern -> [Option]
forall a. Eq a => Pattern a -> [a]
atoms OptPattern
pattern
infoKeys :: [Option]
infoKeys = ([Option] -> [Option] -> [Option]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Option
AnyOption]) ([Option] -> [Option]) -> [Option] -> [Option]
forall a b. (a -> b) -> a -> b
$ OptInfoMap -> [Option]
forall k a. Map k a -> [k]
M.keys OptInfoMap
infomap
allAtoms :: [Option]
allAtoms = [Option] -> [Option]
forall a. Eq a => [a] -> [a]
nub ([Option] -> [Option]) -> [Option] -> [Option]
forall a b. (a -> b) -> a -> b
$ [Option]
patAtoms [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
infoKeys
defaultArgVals :: Arguments
defaultArgVals = (Arguments -> Option -> Arguments)
-> Arguments -> [Option] -> Arguments
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Arguments -> Option -> Arguments
f Arguments
forall k a. Map k a
M.empty [Option]
allAtoms
where f :: Arguments -> Option -> Arguments
f Arguments
argmap Option
atom = (Maybe ArgValue -> Maybe ArgValue)
-> Option -> Arguments -> Arguments
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\Maybe ArgValue
_ -> OptionInfo -> Option -> Maybe ArgValue
optDefaultValue (OptInfoMap
infomap OptInfoMap -> Option -> OptionInfo
forall k a. Ord k => Map k a -> k -> a
M.! Option
atom) Option
atom) Option
atom Arguments
argmap
initialState :: OptParserState
initialState = (OptInfoMap -> OptParserState
fromOptInfoMap OptInfoMap
infomap)
e_parsedArgs :: Either ParseError Arguments
e_parsedArgs = ParsecT String OptParserState Identity Arguments
-> OptParserState
-> String
-> String
-> Either ParseError Arguments
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser ParsecT String OptParserState Identity Arguments
p OptParserState
initialState String
"argv" String
argvString
fillMissingDefaults :: Arguments -> Arguments
fillMissingDefaults Arguments
pargs = Arguments -> Arguments -> Arguments
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Arguments
pargs Arguments
defaultArgVals
in Arguments -> Arguments
fillMissingDefaults (Arguments -> Arguments)
-> Either ParseError Arguments -> Either ParseError Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ParseError Arguments
e_parsedArgs