{-# OPTIONS_GHC -Wno-unused-do-bind #-}
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 :: [Char] -> OptFormat -> CharParser OptParserState ()
buildOptParser [Char]
delim (OptPattern
pattern, OptInfoMap
infomap) =
let
argDelim :: ParsecT [Char] u Identity [Char]
argDelim = (ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity [Char])
-> ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
delim) ParsecT [Char] u Identity [Char]
-> [Char] -> ParsecT [Char] u Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"space between arguments"
makeParser :: OptPattern -> CharParser OptParserState ()
makeParser OptPattern
p = [Char] -> OptFormat -> CharParser OptParserState ()
buildOptParser [Char]
delim (OptPattern
p, OptInfoMap
infomap)
argDelimIfNotInShortOptStack :: CharParser OptParserState ()
argDelimIfNotInShortOptStack = do
OptParserState
st <- ParsecT [Char] 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 [Char] OptParserState Identity [Char]
-> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
argDelim
else () -> CharParser OptParserState ()
forall a. a -> ParsecT [Char] OptParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateOptWith :: (Option -> OptionInfo -> String -> Arguments -> Arguments) ->
Option ->
String ->
CharParser OptParserState ()
updateOptWith :: (Option -> OptionInfo -> [Char] -> Arguments -> Arguments)
-> Option -> [Char] -> CharParser OptParserState ()
updateOptWith Option -> OptionInfo -> [Char] -> Arguments -> Arguments
updateFn Option
opt [Char]
val = do
OptParserState
st <- ParsecT [Char] 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 -> [Char] -> Arguments -> Arguments
updateFn Option
opt OptionInfo
optInfo [Char]
val
updateSt_saveOccurrence :: Option -> [Char] -> CharParser OptParserState ()
updateSt_saveOccurrence Option
opt [Char]
val = (Option -> OptionInfo -> [Char] -> Arguments -> Arguments)
-> Option -> [Char] -> CharParser OptParserState ()
updateOptWith Option -> OptionInfo -> [Char] -> Arguments -> Arguments
saveOccurrence Option
opt [Char]
val
updateSt_assertPresent :: Option -> CharParser OptParserState ()
updateSt_assertPresent Option
opt = (Option -> OptionInfo -> [Char] -> Arguments -> Arguments)
-> Option -> [Char] -> CharParser OptParserState ()
updateOptWith (\Option
opt OptionInfo
info [Char]
_ -> Option -> OptionInfo -> Arguments -> Arguments
assertPresent Option
opt OptionInfo
info) Option
opt [Char]
""
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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (CharParser OptParserState ()
-> CharParser OptParserState () -> CharParser OptParserState ()
forall {a} {b}.
ParsecT [Char] OptParserState Identity a
-> ParsecT [Char] OptParserState Identity b
-> ParsecT [Char] OptParserState Identity b
andThen) (() -> CharParser OptParserState ()
forall a. a -> ParsecT [Char] OptParserState Identity a
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 = False}
ParsecT s OptParserState m b
p ParsecT s OptParserState m b
-> ParsecT s OptParserState m () -> ParsecT s OptParserState m b
forall a b.
ParsecT s OptParserState m a
-> ParsecT s OptParserState m b -> ParsecT s OptParserState m a
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 = ([Char] -> OptFormat -> CharParser OptParserState ()
buildOptParser [Char]
delim) (OptFormat -> CharParser OptParserState ())
-> [OptFormat] -> [CharParser OptParserState ()]
forall a b. (a -> b) -> [a] -> [b]
`map` [OptFormat]
inner_pats
andThen :: ParsecT [Char] OptParserState Identity a
-> ParsecT [Char] OptParserState Identity b
-> ParsecT [Char] OptParserState Identity b
andThen = \ParsecT [Char] OptParserState Identity a
p1 ParsecT [Char] OptParserState Identity b
p2 -> do
ParsecT [Char] OptParserState Identity a
p1
CharParser OptParserState ()
argDelimIfNotInShortOptStack
ParsecT [Char] 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 [Char] 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 [Char] 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 a. a -> ParsecT [Char] OptParserState Identity a
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 [Char] 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 a. a -> ParsecT [Char] OptParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () else Char -> ParsecT [Char] OptParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT [Char] OptParserState Identity Char
-> CharParser OptParserState () -> CharParser OptParserState ()
forall {a} {b}.
ParsecT [Char] OptParserState Identity a
-> ParsecT [Char] OptParserState Identity b
-> ParsecT [Char] OptParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CharParser OptParserState ()
forall a. a -> ParsecT [Char] OptParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char -> ParsecT [Char] 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
[Char]
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 [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char])
-> ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
ParsecT [Char] OptParserState Identity [Char]
-> CharParser OptParserState ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Char] OptParserState Identity [Char]
-> CharParser OptParserState ())
-> ParsecT [Char] OptParserState Identity [Char]
-> CharParser OptParserState ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"=" ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
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 [Char] OptParserState Identity Char
-> CharParser OptParserState ()
-> ParsecT [Char] OptParserState Identity [Char]
forall u a b. CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 ParsecT [Char] OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT [Char] OptParserState Identity [Char]
-> CharParser OptParserState ()
forall u a. CharParser u a -> CharParser u ()
lookAhead_ ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
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 [Char] OptParserState Identity [Char]
-> CharParser OptParserState Bool
forall a u. Show a => CharParser u a -> CharParser u Bool
isNotFollowedBy ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
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
[Char] -> ParsecT [Char] OptParserState Identity [Char]
forall a. a -> ParsecT [Char] OptParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
(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 -> [Char] -> Arguments -> Arguments
saveOccurrence Option
syn OptionInfo
info [Char]
val Arguments
pa
CharParser OptParserState ()
-> [Char] -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Option -> [Char]
humanize Option
o
o :: Option
o@(LongOption [Char]
name) ->
do [Char] -> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"--"
[Char] -> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
name
[Char]
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
[Char] -> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"=" ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
argDelim
ParsecT [Char] OptParserState Identity Char
-> CharParser OptParserState ()
-> ParsecT [Char] OptParserState Identity [Char]
forall u a b. CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 ParsecT [Char] OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT [Char] OptParserState Identity [Char]
-> CharParser OptParserState ()
forall u a. CharParser u a -> CharParser u ()
lookAhead_ ParsecT [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
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 [Char] -> ParsecT [Char] OptParserState Identity [Char]
forall a. a -> ParsecT [Char] OptParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
(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 -> [Char] -> Arguments -> Arguments
saveOccurrence Option
syn OptionInfo
info [Char]
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 ()
-> [Char] -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Option -> [Char]
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 = [Char] -> OptFormat -> CharParser OptParserState ()
buildOptParser [Char]
delim ([OptPattern] -> OptPattern
forall a. [Pattern a] -> Pattern a
Unordered [OptPattern]
oneOfSyns, OptInfoMap
infomap)
in CharParser OptParserState ()
unorderedSynParser
CharParser OptParserState ()
-> [Char] -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Option -> [Char]
humanize Option
o
o :: Option
o@(Argument [Char]
_name) ->
do [Char]
val <- ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char])
-> ParsecT [Char] OptParserState Identity [Char]
-> ParsecT [Char] OptParserState Identity [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] OptParserState Identity Char
-> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] OptParserState Identity [Char]
-> 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 [Char] OptParserState Identity [Char]
forall {u}. ParsecT [Char] u Identity [Char]
argDelim CharParser OptParserState ()
-> ParsecT [Char] OptParserState Identity Char
-> ParsecT [Char] OptParserState Identity Char
forall {a} {b}.
ParsecT [Char] OptParserState Identity a
-> ParsecT [Char] OptParserState Identity b
-> ParsecT [Char] OptParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] OptParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
Option -> [Char] -> CharParser OptParserState ()
updateSt_saveOccurrence Option
o [Char]
val
Bool -> CharParser OptParserState ()
forall {s}. Bool -> ParsecT s OptParserState Identity ()
updateSt_inShortOptStack Bool
False
CharParser OptParserState ()
-> [Char] -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Option -> [Char]
humanize Option
o
o :: Option
o@(Command [Char]
name) ->
do [Char] -> ParsecT [Char] OptParserState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
name
Option -> CharParser OptParserState ()
updateSt_assertPresent Option
o
Bool -> CharParser OptParserState ()
forall {s}. Bool -> ParsecT s OptParserState Identity ()
updateSt_inShortOptStack Bool
False
CharParser OptParserState ()
-> [Char] -> CharParser OptParserState ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Option -> [Char]
humanize Option
o
returnState :: CharParser u a -> CharParser u u
returnState :: forall u a. CharParser u a -> CharParser u u
returnState CharParser u a
p = CharParser u a
p CharParser u a
-> ParsecT [Char] u Identity u -> ParsecT [Char] u Identity u
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] u Identity 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 = b}
updateParsedArgs :: (Arguments -> Arguments) -> OptParserState -> OptParserState
updateParsedArgs :: (Arguments -> Arguments) -> OptParserState -> OptParserState
updateParsedArgs Arguments -> Arguments
f OptParserState
st = OptParserState
st {parsedArgs = f $ parsedArgs st}
saveOccurrence :: Option -> OptionInfo -> String -> Arguments -> Arguments
saveOccurrence :: Option -> OptionInfo -> [Char] -> Arguments -> Arguments
saveOccurrence Option
opt OptionInfo
info [Char]
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 -> ([Char]
newval [Char] -> 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 -> [Char]
newval [Char] -> ArgValue -> Maybe ArgValue
`updateFrom` ArgValue
oldval
updateFrom :: [Char] -> ArgValue -> Maybe ArgValue
updateFrom [Char]
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 [[Char]]
vs -> [[Char]] -> ArgValue
MultiValue ([[Char]] -> ArgValue) -> [[Char]] -> ArgValue
forall a b. (a -> b) -> a -> b
$ [Char]
newval [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
vs
Value [Char]
_v -> [Char] -> ArgValue
Value [Char]
newval
ArgValue
NoValue -> [Char] -> ArgValue
Value [Char]
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 -> [Char] -> Arguments -> Arguments
saveOccurrence Option
opt OptionInfo
info [Char]
"" 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 = foldl foldsavefn args 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 [Char]
_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 [Char]
_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 [[Char]] -> 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 [[Char]] -> 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 [Char]
_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 [Char]
_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 [[Char]] -> 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 [Char]
defaultVal OptionInfo
info of
Just [Char]
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 [[Char]] -> ArgValue
MultiValue ([[Char]] -> ArgValue) -> [[Char]] -> ArgValue
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
dval
else [Char] -> ArgValue
Value [Char]
dval
Maybe [Char]
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 [[Char]] -> 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 -> [[Char]] -> Either ParseError Arguments
getArguments OptFormat
optfmt [[Char]]
argv =
let (OptPattern
pattern, OptInfoMap
infomap) = OptFormat
optfmt
delim :: [Char]
delim = [Char]
"«»"
argvString :: [Char]
argvString = [Char]
delim [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
`intercalate` [[Char]]
argv
p :: ParsecT [Char] OptParserState Identity Arguments
p = OptParserState -> Arguments
parsedArgs (OptParserState -> Arguments)
-> ParsecT [Char] OptParserState Identity OptParserState
-> ParsecT [Char] OptParserState Identity Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser OptParserState ()
-> ParsecT [Char] OptParserState Identity OptParserState
forall u a. CharParser u a -> CharParser u u
returnState ([Char] -> OptFormat -> CharParser OptParserState ()
buildOptParser [Char]
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 b a. (b -> a -> b) -> b -> [a] -> b
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 [Char] OptParserState Identity Arguments
-> OptParserState
-> [Char]
-> [Char]
-> Either ParseError Arguments
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT [Char] OptParserState Identity Arguments
p OptParserState
initialState [Char]
"argv" [Char]
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