module Options.OptStream.Raw
( module Options.OptStream.Classes
, RawParser
, runParser
, runParserIO
, parseArgs
, OptionForm
, isLegalOptionForm
, flag'
, flagSep'
, param'
, paramRead'
, paramChar'
, freeArg'
, freeArgRead'
, freeArgChar'
, anyArg'
, anyArgRead'
, anyArgChar'
, multiParam'
, RawFollower
, next
, nextRead
, nextChar
, nextMetavar
, withVersion'
, withVersionIO'
, beforeDashes
, block
, short
, match
, matchAndFollow
, matchShort
, quiet
, eject
, ParserError
, formatParserError
)
where
import Control.Applicative hiding (some, many)
import Control.Monad hiding (fail)
import Control.Monad.Fail
import Data.Foldable
import Data.Functor
import Data.List
import Data.Maybe
import Prelude hiding (fail)
import Text.Read
import Options.OptStream.Classes
import Options.OptStream.Internal
import Options.OptStream.IOOps
data Context
= CtxStart
| CtxArg String
| CtxShort String Char
| CtxEnd
deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Eq Context
Eq Context
-> (Context -> Context -> Ordering)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Context)
-> (Context -> Context -> Context)
-> Ord Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c< :: Context -> Context -> Bool
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
$cp1Ord :: Eq Context
Ord, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)
data ParserError
= UnexpectedArg String
| UnexpectedChar Char String
| MissingArgAfter [String] String
| MissingArg Context [String]
| CustomError Context String
deriving (ParserError -> ParserError -> Bool
(ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> Bool) -> Eq ParserError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserError -> ParserError -> Bool
$c/= :: ParserError -> ParserError -> Bool
== :: ParserError -> ParserError -> Bool
$c== :: ParserError -> ParserError -> Bool
Eq, Eq ParserError
Eq ParserError
-> (ParserError -> ParserError -> Ordering)
-> (ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> ParserError)
-> (ParserError -> ParserError -> ParserError)
-> Ord ParserError
ParserError -> ParserError -> Bool
ParserError -> ParserError -> Ordering
ParserError -> ParserError -> ParserError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParserError -> ParserError -> ParserError
$cmin :: ParserError -> ParserError -> ParserError
max :: ParserError -> ParserError -> ParserError
$cmax :: ParserError -> ParserError -> ParserError
>= :: ParserError -> ParserError -> Bool
$c>= :: ParserError -> ParserError -> Bool
> :: ParserError -> ParserError -> Bool
$c> :: ParserError -> ParserError -> Bool
<= :: ParserError -> ParserError -> Bool
$c<= :: ParserError -> ParserError -> Bool
< :: ParserError -> ParserError -> Bool
$c< :: ParserError -> ParserError -> Bool
compare :: ParserError -> ParserError -> Ordering
$ccompare :: ParserError -> ParserError -> Ordering
$cp1Ord :: Eq ParserError
Ord, Int -> ParserError -> ShowS
[ParserError] -> ShowS
ParserError -> String
(Int -> ParserError -> ShowS)
-> (ParserError -> String)
-> ([ParserError] -> ShowS)
-> Show ParserError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserError] -> ShowS
$cshowList :: [ParserError] -> ShowS
show :: ParserError -> String
$cshow :: ParserError -> String
showsPrec :: Int -> ParserError -> ShowS
$cshowsPrec :: Int -> ParserError -> ShowS
Show)
formatParserError :: ParserError -> String
formatParserError :: ParserError -> String
formatParserError (UnexpectedArg String
arg) =
String
"unexpected command line argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
formatParserError (UnexpectedChar Char
c String
arg) =
String
"unexpected character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in command line argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
formatParserError (MissingArgAfter [String]
args String
metavar) =
String
"missing command line argument after "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> String
show ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
metavar
formatParserError (MissingArg Context
ctx [String]
ss) =
String
"missing command line argument"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ( case Context
ctx of
CtxArg String
arg -> String
" before " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
CtxShort String
arg Char
c -> String
" before flag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
Context
CtxStart -> String
""
Context
CtxEnd -> String
"" )
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" | " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
ss)
formatParserError (CustomError Context
ctx String
msg) =
String
"command line error"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ( case Context
ctx of
CtxArg String
arg -> String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
CtxShort String
arg Char
c -> String
" at flag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
arg
Context
CtxStart -> String
""
Context
CtxEnd -> String
"" )
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
data RawFollower a
= FollowerDone (Either String a)
| FollowerNext String (String -> RawFollower a)
data FollowerError
= FollowerMissingArg String
| FollowerCustomError Context String
nextMetavar :: RawFollower a -> Maybe String
nextMetavar :: RawFollower a -> Maybe String
nextMetavar (FollowerDone Either String a
_) = Maybe String
forall a. Maybe a
Nothing
nextMetavar (FollowerNext String
v String -> RawFollower a
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
v
runFollower :: Context
-> RawFollower a
-> [String]
-> Either FollowerError (Context, a, [String])
runFollower :: Context
-> RawFollower a
-> [String]
-> Either FollowerError (Context, a, [String])
runFollower Context
ctx (FollowerDone (Right a
a)) [String]
ss = (Context, a, [String])
-> Either FollowerError (Context, a, [String])
forall a b. b -> Either a b
Right (Context
ctx, a
a, [String]
ss)
runFollower Context
ctx (FollowerDone (Left String
e)) [String]
_ = FollowerError -> Either FollowerError (Context, a, [String])
forall a b. a -> Either a b
Left (FollowerError -> Either FollowerError (Context, a, [String]))
-> FollowerError -> Either FollowerError (Context, a, [String])
forall a b. (a -> b) -> a -> b
$ Context -> String -> FollowerError
FollowerCustomError Context
ctx String
e
runFollower Context
_ (FollowerNext String
v String -> RawFollower a
_) [] = FollowerError -> Either FollowerError (Context, a, [String])
forall a b. a -> Either a b
Left (FollowerError -> Either FollowerError (Context, a, [String]))
-> FollowerError -> Either FollowerError (Context, a, [String])
forall a b. (a -> b) -> a -> b
$ String -> FollowerError
FollowerMissingArg String
v
runFollower Context
_ (FollowerNext String
_ String -> RawFollower a
f) (String
s:[String]
ss) = Context
-> RawFollower a
-> [String]
-> Either FollowerError (Context, a, [String])
forall a.
Context
-> RawFollower a
-> [String]
-> Either FollowerError (Context, a, [String])
runFollower (String -> Context
CtxArg String
s) (String -> RawFollower a
f String
s) [String]
ss
instance Functor RawFollower where
fmap :: (a -> b) -> RawFollower a -> RawFollower b
fmap = (a -> b) -> RawFollower a -> RawFollower b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance FunctorFail RawFollower where
fmapOrFail :: (a -> Either String b) -> RawFollower a -> RawFollower b
fmapOrFail = (a -> Either String b) -> RawFollower a -> RawFollower b
forall (f :: * -> *) a b.
MonadFail f =>
(a -> Either String b) -> f a -> f b
fmapOrFailM
instance Applicative RawFollower where
pure :: a -> RawFollower a
pure = a -> RawFollower a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: RawFollower (a -> b) -> RawFollower a -> RawFollower b
(<*>) = RawFollower (a -> b) -> RawFollower a -> RawFollower b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance ApplicativeFail RawFollower where
failA :: String -> RawFollower a
failA = String -> RawFollower a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
instance Monad RawFollower where
return :: a -> RawFollower a
return = Either String a -> RawFollower a
forall a. Either String a -> RawFollower a
FollowerDone (Either String a -> RawFollower a)
-> (a -> Either String a) -> a -> RawFollower a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String a
forall a b. b -> Either a b
Right
FollowerDone (Right a
a) >>= :: RawFollower a -> (a -> RawFollower b) -> RawFollower b
>>= a -> RawFollower b
g = a -> RawFollower b
g a
a
FollowerDone (Left String
e) >>= a -> RawFollower b
_ = Either String b -> RawFollower b
forall a. Either String a -> RawFollower a
FollowerDone (Either String b -> RawFollower b)
-> Either String b -> RawFollower b
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left String
e
FollowerNext String
v String -> RawFollower a
f >>= a -> RawFollower b
g = String -> (String -> RawFollower b) -> RawFollower b
forall a. String -> (String -> RawFollower a) -> RawFollower a
FollowerNext String
v ((String -> RawFollower b) -> RawFollower b)
-> (String -> RawFollower b) -> RawFollower b
forall a b. (a -> b) -> a -> b
$ (RawFollower a -> (a -> RawFollower b) -> RawFollower b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RawFollower b
g) (RawFollower a -> RawFollower b)
-> (String -> RawFollower a) -> String -> RawFollower b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawFollower a
f
instance MonadFail RawFollower where
fail :: String -> RawFollower a
fail = Either String a -> RawFollower a
forall a. Either String a -> RawFollower a
FollowerDone (Either String a -> RawFollower a)
-> (String -> Either String a) -> String -> RawFollower a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left
next :: String
-> RawFollower String
next :: String -> RawFollower String
next String
metavar = String -> (String -> RawFollower String) -> RawFollower String
forall a. String -> (String -> RawFollower a) -> RawFollower a
FollowerNext String
metavar String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return
data DoneError
= DEMissingArg [String]
| DECustomError String
deriving Int -> DoneError -> ShowS
[DoneError] -> ShowS
DoneError -> String
(Int -> DoneError -> ShowS)
-> (DoneError -> String)
-> ([DoneError] -> ShowS)
-> Show DoneError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DoneError] -> ShowS
$cshowList :: [DoneError] -> ShowS
show :: DoneError -> String
$cshow :: DoneError -> String
showsPrec :: Int -> DoneError -> ShowS
$cshowsPrec :: Int -> DoneError -> ShowS
Show
type DoneParser a = Either DoneError a
type EndHandler a = Either (List String) (DoneParser a)
data Action a
= ConsumeBlock (RawFollower a)
| ConsumeShort a
instance Functor Action where
fmap :: (a -> b) -> Action a -> Action b
fmap a -> b
f (ConsumeBlock RawFollower a
fa) = RawFollower b -> Action b
forall a. RawFollower a -> Action a
ConsumeBlock (RawFollower b -> Action b) -> RawFollower b -> Action b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> RawFollower a -> RawFollower b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f RawFollower a
fa
fmap a -> b
f (ConsumeShort a
a) = b -> Action b
forall a. a -> Action a
ConsumeShort (b -> Action b) -> b -> Action b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
abort :: Action a -> b -> Action b
abort :: Action a -> b -> Action b
abort (ConsumeBlock RawFollower a
_) b
b = RawFollower b -> Action b
forall a. RawFollower a -> Action a
ConsumeBlock (RawFollower b -> Action b) -> RawFollower b -> Action b
forall a b. (a -> b) -> a -> b
$ b -> RawFollower b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
abort (ConsumeShort a
_) b
b = b -> Action b
forall a. a -> Action a
ConsumeShort b
b
type InputHandler a = Maybe String -> Maybe Char -> Maybe (Action (RawParser a))
data RawParser a
= Done (DoneParser a)
| Scan (EndHandler a) (InputHandler a)
data ShortsError
= SEUnexpectedChar Char
| SEDoneError Context DoneError
runShorts :: String
-> Context
-> RawParser a
-> [Char]
-> Either ShortsError (Context, RawParser a)
runShorts :: String
-> Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
runShorts String
arg = Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
forall a.
Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
doRun where
doRun :: Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
doRun Context
ctx RawParser a
pa [] = (Context, RawParser a) -> Either ShortsError (Context, RawParser a)
forall a b. b -> Either a b
Right (Context
ctx, RawParser a
pa)
doRun Context
ctx (Done (Left DoneError
e)) (Char
_:String
_) = ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. a -> Either a b
Left (ShortsError -> Either ShortsError (Context, RawParser a))
-> ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. (a -> b) -> a -> b
$ Context -> DoneError -> ShortsError
SEDoneError Context
ctx DoneError
e
doRun Context
_ (Done (Right a
_)) (Char
c:String
_) = ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. a -> Either a b
Left (ShortsError -> Either ShortsError (Context, RawParser a))
-> ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. (a -> b) -> a -> b
$ Char -> ShortsError
SEUnexpectedChar Char
c
doRun Context
_ (Scan EndHandler a
_ InputHandler a
inputH) (Char
c:String
cs) = case InputHandler a
inputH Maybe String
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c) of
Just (ConsumeShort RawParser a
pa') -> Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
doRun (String -> Char -> Context
CtxShort String
arg Char
c) RawParser a
pa' String
cs
Just (ConsumeBlock RawFollower (RawParser a)
_) -> String -> Either ShortsError (Context, RawParser a)
forall a. HasCallStack => String -> a
error String
"ConsumeBlock in response to short input"
Maybe (Action (RawParser a))
Nothing -> ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. a -> Either a b
Left (ShortsError -> Either ShortsError (Context, RawParser a))
-> ShortsError -> Either ShortsError (Context, RawParser a)
forall a b. (a -> b) -> a -> b
$ Char -> ShortsError
SEUnexpectedChar Char
c
missingArg :: Context -> List String -> ParserError
missingArg :: Context -> List String -> ParserError
missingArg Context
ctx = Context -> [String] -> ParserError
MissingArg Context
ctx ([String] -> ParserError)
-> (List String -> [String]) -> List String -> ParserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String])
-> (List String -> [String]) -> List String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
doneMissingArg :: List String -> DoneParser a
doneMissingArg :: List String -> DoneParser a
doneMissingArg = DoneError -> DoneParser a
forall a b. a -> Either a b
Left (DoneError -> DoneParser a)
-> (List String -> DoneError) -> List String -> DoneParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> DoneError
DEMissingArg ([String] -> DoneError)
-> (List String -> [String]) -> List String -> DoneError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String])
-> (List String -> [String]) -> List String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
toParserError :: Context -> DoneError -> ParserError
toParserError :: Context -> DoneError -> ParserError
toParserError Context
ctx (DEMissingArg [String]
vs) = Context -> [String] -> ParserError
MissingArg Context
ctx [String]
vs
toParserError Context
ctx (DECustomError String
msg) = Context -> String -> ParserError
CustomError Context
ctx String
msg
runParser :: RawParser a -> [String] -> Either ParserError a
runParser :: RawParser a -> [String] -> Either ParserError a
runParser = Context -> RawParser a -> [String] -> Either ParserError a
forall a.
Context -> RawParser a -> [String] -> Either ParserError a
doRun Context
CtxStart where
doRun :: Context -> RawParser a -> [String] -> Either ParserError a
doRun Context
ctx (Done (Left DoneError
e)) [String]
_ = ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Context -> DoneError -> ParserError
toParserError Context
ctx DoneError
e
doRun Context
_ (Done (Right a
a)) [] = a -> Either ParserError a
forall a b. b -> Either a b
Right (a -> Either ParserError a) -> a -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ a
a
doRun Context
_ (Done (Right a
_)) (String
s:[String]
_) = ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ String -> ParserError
UnexpectedArg String
s
doRun Context
_ (Scan (Left List String
xs) InputHandler a
_) [] = ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Context -> List String -> ParserError
missingArg Context
CtxEnd List String
xs
doRun Context
_ (Scan (Right (Right a
a)) InputHandler a
_) [] = a -> Either ParserError a
forall a b. b -> Either a b
Right a
a
doRun Context
_ (Scan (Right (Left DoneError
e)) InputHandler a
_) [] = ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Context -> DoneError -> ParserError
toParserError Context
CtxEnd DoneError
e
doRun Context
_ (Scan Either (List String) (Either DoneError a)
_ InputHandler a
inputH) (String
s:[String]
ss) = case InputHandler a
inputH (String -> Maybe String
forall a. a -> Maybe a
Just String
s) Maybe Char
mc of
Just (ConsumeBlock RawFollower (RawParser a)
fpa) -> case Context
-> RawFollower (RawParser a)
-> [String]
-> Either FollowerError (Context, RawParser a, [String])
forall a.
Context
-> RawFollower a
-> [String]
-> Either FollowerError (Context, a, [String])
runFollower (String -> Context
CtxArg String
s) RawFollower (RawParser a)
fpa [String]
ss of
Right (Context
ctx', RawParser a
pa', [String]
ss') -> Context -> RawParser a -> [String] -> Either ParserError a
doRun Context
ctx' RawParser a
pa' [String]
ss'
Left (FollowerMissingArg String
v) -> ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ [String] -> String -> ParserError
MissingArgAfter (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) String
v
Left (FollowerCustomError Context
ctx' String
e) -> ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Context -> String -> ParserError
CustomError Context
ctx' String
e
Just (ConsumeShort RawParser a
pa') -> case Maybe (Char, String)
shorts of
Just (Char
c, String
cs) -> case String
-> Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
forall a.
String
-> Context
-> RawParser a
-> String
-> Either ShortsError (Context, RawParser a)
runShorts String
s (String -> Char -> Context
CtxShort String
s Char
c) RawParser a
pa' String
cs of
Right (Context
ctx', RawParser a
pa'') -> Context -> RawParser a -> [String] -> Either ParserError a
doRun Context
ctx' RawParser a
pa'' [String]
ss
Left (SEUnexpectedChar Char
c') -> ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Char -> String -> ParserError
UnexpectedChar Char
c' String
s
Left (SEDoneError Context
ctx' DoneError
e) -> ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ Context -> DoneError -> ParserError
toParserError Context
ctx' DoneError
e
Maybe (Char, String)
Nothing -> String -> Either ParserError a
forall a. HasCallStack => String -> a
error String
"ConsumeShort in response to long input"
Maybe (Action (RawParser a))
Nothing -> ParserError -> Either ParserError a
forall a b. a -> Either a b
Left (ParserError -> Either ParserError a)
-> ParserError -> Either ParserError a
forall a b. (a -> b) -> a -> b
$ String -> ParserError
UnexpectedArg String
s
where
shorts :: Maybe (Char, String)
shorts = case String
s of
(Char
'-':(Char
c:String
cs)) -> (Char, String) -> Maybe (Char, String)
forall a. a -> Maybe a
Just (Char
c, String
cs)
String
_ -> Maybe (Char, String)
forall a. Maybe a
Nothing
mc :: Maybe Char
mc = ((Char, String) -> Char) -> Maybe (Char, String) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, String) -> Char
forall a b. (a, b) -> a
fst Maybe (Char, String)
shorts
endAlternative :: EndHandler a -> EndHandler a -> EndHandler a
endAlternative :: EndHandler a -> EndHandler a -> EndHandler a
endAlternative (Right DoneParser a
da) EndHandler a
_ = DoneParser a -> EndHandler a
forall a b. b -> Either a b
Right DoneParser a
da
endAlternative EndHandler a
_ (Right DoneParser a
da) = DoneParser a -> EndHandler a
forall a b. b -> Either a b
Right DoneParser a
da
endAlternative (Left List String
xs) (Left List String
xs') = List String -> EndHandler a
forall a b. a -> Either a b
Left (List String -> EndHandler a) -> List String -> EndHandler a
forall a b. (a -> b) -> a -> b
$ List String
xs List String -> List String -> List String
forall a. Semigroup a => a -> a -> a
<> List String
xs'
endParallel :: EndHandler (a -> b) -> EndHandler a -> EndHandler b
endParallel :: EndHandler (a -> b) -> EndHandler a -> EndHandler b
endParallel (Right (Left DoneError
e)) EndHandler a
_ = Either DoneError b -> EndHandler b
forall a b. b -> Either a b
Right (DoneError -> Either DoneError b
forall a b. a -> Either a b
Left DoneError
e)
endParallel (Right (Right a -> b
f)) EndHandler a
eda = ((Either DoneError a -> Either DoneError b)
-> EndHandler a -> EndHandler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either DoneError a -> Either DoneError b)
-> EndHandler a -> EndHandler b)
-> ((a -> b) -> Either DoneError a -> Either DoneError b)
-> (a -> b)
-> EndHandler a
-> EndHandler b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Either DoneError a -> Either DoneError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f EndHandler a
eda
endParallel EndHandler (a -> b)
_ (Right (Left DoneError
e)) = Either DoneError b -> EndHandler b
forall a b. b -> Either a b
Right (DoneError -> Either DoneError b
forall a b. a -> Either a b
Left DoneError
e)
endParallel EndHandler (a -> b)
edf (Right (Right a
a)) = ((Either DoneError (a -> b) -> Either DoneError b)
-> EndHandler (a -> b) -> EndHandler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either DoneError (a -> b) -> Either DoneError b)
-> EndHandler (a -> b) -> EndHandler b)
-> (((a -> b) -> b)
-> Either DoneError (a -> b) -> Either DoneError b)
-> ((a -> b) -> b)
-> EndHandler (a -> b)
-> EndHandler b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> b) -> Either DoneError (a -> b) -> Either DoneError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) EndHandler (a -> b)
edf
endParallel (Left List String
xs) (Left List String
xs') = List String -> EndHandler b
forall a b. a -> Either a b
Left (List String -> EndHandler b) -> List String -> EndHandler b
forall a b. (a -> b) -> a -> b
$ List String
xs List String -> List String -> List String
forall a. Semigroup a => a -> a -> a
<> List String
xs'
instance Functor RawParser where
fmap :: (a -> b) -> RawParser a -> RawParser b
fmap = (a -> b) -> RawParser a -> RawParser b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance FunctorFail RawParser where
fmapOrFail :: (a -> Either String b) -> RawParser a -> RawParser b
fmapOrFail = (a -> Either String b) -> RawParser a -> RawParser b
forall (f :: * -> *) a b.
MonadFail f =>
(a -> Either String b) -> f a -> f b
fmapOrFailM
instance Applicative RawParser where
pure :: a -> RawParser a
pure = a -> RawParser a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: RawParser (a -> b) -> RawParser a -> RawParser b
(<*>) = RawParser (a -> b) -> RawParser a -> RawParser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance ApplicativeFail RawParser where
failA :: String -> RawParser a
failA = String -> RawParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
instance Monad RawParser where
return :: a -> RawParser a
return = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done (DoneParser a -> RawParser a)
-> (a -> DoneParser a) -> a -> RawParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DoneParser a
forall a b. b -> Either a b
Right
Done (Right a
a) >>= :: RawParser a -> (a -> RawParser b) -> RawParser b
>>= a -> RawParser b
f = a -> RawParser b
f a
a
Done (Left DoneError
e) >>= a -> RawParser b
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
Scan EndHandler a
endH InputHandler a
inputH >>= a -> RawParser b
f = EndHandler b -> InputHandler b -> RawParser b
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler b
endH' InputHandler b
inputH' where
endH' :: EndHandler b
endH' = case EndHandler a
endH of
Left List String
xs -> List String -> EndHandler b
forall a b. a -> Either a b
Left List String
xs
Right (Left DoneError
e) -> DoneParser b -> EndHandler b
forall a b. b -> Either a b
Right (DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e)
Right (Right a
a) -> case a -> RawParser b
f a
a of
Done DoneParser b
db -> DoneParser b -> EndHandler b
forall a b. b -> Either a b
Right DoneParser b
db
Scan EndHandler b
endH'' InputHandler b
_ -> EndHandler b
endH''
inputH' :: InputHandler b
inputH' Maybe String
ms Maybe Char
mc = ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> ((RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b))
-> (RawParser a -> RawParser b)
-> Maybe (Action (RawParser a))
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (RawParser a -> (a -> RawParser b) -> RawParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RawParser b
f) (Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ InputHandler a
inputH Maybe String
ms Maybe Char
mc
instance MonadFail RawParser where
fail :: String -> RawParser a
fail = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done (DoneParser a -> RawParser a)
-> (String -> DoneParser a) -> String -> RawParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoneError -> DoneParser a
forall a b. a -> Either a b
Left (DoneError -> DoneParser a)
-> (String -> DoneError) -> String -> DoneParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DoneError
DECustomError
instance Alternative RawParser where
empty :: RawParser a
empty = EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan (List String -> EndHandler a
forall a b. a -> Either a b
Left List String
forall a. Monoid a => a
mempty) ((Maybe Char -> Maybe (Action (RawParser a))) -> InputHandler a
forall a b. a -> b -> a
const ((Maybe Char -> Maybe (Action (RawParser a))) -> InputHandler a)
-> (Maybe Char -> Maybe (Action (RawParser a))) -> InputHandler a
forall a b. (a -> b) -> a -> b
$ Maybe (Action (RawParser a))
-> Maybe Char -> Maybe (Action (RawParser a))
forall a b. a -> b -> a
const Maybe (Action (RawParser a))
forall a. Maybe a
Nothing)
Done DoneParser a
da <|> :: RawParser a -> RawParser a -> RawParser a
<|> RawParser a
_ = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
RawParser a
_ <|> Done DoneParser a
da = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
Scan EndHandler a
endH InputHandler a
inputH <|> Scan EndHandler a
endH' InputHandler a
inputH' =
EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler a
endH'' InputHandler a
inputH'' where
endH'' :: EndHandler a
endH'' = EndHandler a
endH EndHandler a -> EndHandler a -> EndHandler a
forall a. EndHandler a -> EndHandler a -> EndHandler a
`endAlternative` EndHandler a
endH'
inputH'' :: InputHandler a
inputH'' Maybe String
ms Maybe Char
mc = InputHandler a
inputH Maybe String
ms Maybe Char
mc Maybe (Action (RawParser a))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser a))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InputHandler a
inputH' Maybe String
ms Maybe Char
mc
instance SelectiveParser RawParser where
Done (Right a -> b
f) <#> :: RawParser (a -> b) -> RawParser a -> RawParser b
<#> RawParser a
pa = (a -> b) -> RawParser a -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f RawParser a
pa
Done (Left DoneError
e) <#> RawParser a
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
RawParser (a -> b)
pf <#> Done (Right a
a) = ((a -> b) -> b) -> RawParser (a -> b) -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) RawParser (a -> b)
pf
RawParser (a -> b)
_ <#> Done (Left DoneError
e) = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
pf :: RawParser (a -> b)
pf@(Scan EndHandler (a -> b)
endH InputHandler (a -> b)
inputH) <#> pa :: RawParser a
pa@(Scan EndHandler a
endH' InputHandler a
inputH') =
EndHandler b -> InputHandler b -> RawParser b
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler b
endH'' InputHandler b
inputH'' where
endH'' :: EndHandler b
endH'' = EndHandler (a -> b)
endH EndHandler (a -> b) -> EndHandler a -> EndHandler b
forall a b. EndHandler (a -> b) -> EndHandler a -> EndHandler b
`endParallel` EndHandler a
endH'
inputH'' :: InputHandler b
inputH'' Maybe String
ms Maybe Char
mc = case InputHandler (a -> b)
inputH Maybe String
ms Maybe Char
mc of
Just Action (RawParser (a -> b))
apf -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ (RawParser (a -> b) -> RawParser b)
-> Action (RawParser (a -> b)) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawParser (a -> b) -> RawParser a -> RawParser b
forall (p :: * -> *) a b.
SelectiveParser p =>
p (a -> b) -> p a -> p b
<#> RawParser a
pa) Action (RawParser (a -> b))
apf
Maybe (Action (RawParser (a -> b)))
Nothing -> ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> ((RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b))
-> (RawParser a -> RawParser b)
-> Maybe (Action (RawParser a))
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (RawParser (a -> b)
pf RawParser (a -> b) -> RawParser a -> RawParser b
forall (p :: * -> *) a b.
SelectiveParser p =>
p (a -> b) -> p a -> p b
<#>) (Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ InputHandler a
inputH' Maybe String
ms Maybe Char
mc
Done (Right a -> b
f) <-#> :: RawParser (a -> b) -> RawParser a -> RawParser b
<-#> RawParser a
pa = (a -> b) -> RawParser a -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f RawParser a
pa
Done (Left DoneError
e) <-#> RawParser a
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
Scan (Right Either DoneError (a -> b)
df) InputHandler (a -> b)
_ <-#> Done DoneParser a
da = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ Either DoneError (a -> b)
df Either DoneError (a -> b) -> DoneParser a -> DoneParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoneParser a
da
Scan (Left List String
xs) InputHandler (a -> b)
_ <-#> Done (Right a
_) = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ List String -> DoneParser b
forall a. List String -> DoneParser a
doneMissingArg List String
xs
Scan (Left List String
_) InputHandler (a -> b)
_ <-#> Done (Left DoneError
e) = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
Scan Either (List String) (Either DoneError (a -> b))
endH InputHandler (a -> b)
inputH <-#> pa :: RawParser a
pa@(Scan EndHandler a
endH' InputHandler a
inputH') = EndHandler b -> InputHandler b -> RawParser b
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler b
endH'' InputHandler b
inputH'' where
endH'' :: EndHandler b
endH'' = Either (List String) (Either DoneError (a -> b))
endH Either (List String) (Either DoneError (a -> b))
-> EndHandler a -> EndHandler b
forall a b. EndHandler (a -> b) -> EndHandler a -> EndHandler b
`endParallel` EndHandler a
endH'
inputH'' :: InputHandler b
inputH'' Maybe String
ms Maybe Char
mc = case InputHandler (a -> b)
inputH Maybe String
ms Maybe Char
mc of
Just Action (RawParser (a -> b))
apf -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ (RawParser (a -> b) -> RawParser b)
-> Action (RawParser (a -> b)) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawParser (a -> b) -> RawParser a -> RawParser b
forall (p :: * -> *) a b.
SelectiveParser p =>
p (a -> b) -> p a -> p b
<-#> RawParser a
pa) Action (RawParser (a -> b))
apf
Maybe (Action (RawParser (a -> b)))
Nothing -> case InputHandler a
inputH' Maybe String
ms Maybe Char
mc of
Just Action (RawParser a)
apa -> case Either (List String) (Either DoneError (a -> b))
endH of
Right (Right a -> b
f) -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ ((RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b))
-> ((a -> b) -> RawParser a -> RawParser b)
-> (a -> b)
-> Action (RawParser a)
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> RawParser a -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f Action (RawParser a)
apa
Right (Left DoneError
e) -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> (DoneParser b -> Action (RawParser b))
-> DoneParser b
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action (RawParser a) -> RawParser b -> Action (RawParser b)
forall a b. Action a -> b -> Action b
abort Action (RawParser a)
apa (RawParser b -> Action (RawParser b))
-> (DoneParser b -> RawParser b)
-> DoneParser b
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> Maybe (Action (RawParser b)))
-> DoneParser b -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
Left List String
xs -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> (DoneParser b -> Action (RawParser b))
-> DoneParser b
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action (RawParser a) -> RawParser b -> Action (RawParser b)
forall a b. Action a -> b -> Action b
abort Action (RawParser a)
apa (RawParser b -> Action (RawParser b))
-> (DoneParser b -> RawParser b)
-> DoneParser b
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> Maybe (Action (RawParser b)))
-> DoneParser b -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ List String -> DoneParser b
forall a. List String -> DoneParser a
doneMissingArg List String
xs
Maybe (Action (RawParser a))
Nothing -> Maybe (Action (RawParser b))
forall a. Maybe a
Nothing
Done DoneParser (a -> b)
df <#-> :: RawParser (a -> b) -> RawParser a -> RawParser b
<#-> Done DoneParser a
da = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneParser (a -> b)
df DoneParser (a -> b) -> DoneParser a -> DoneParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoneParser a
da
Done DoneParser (a -> b)
df <#-> Scan (Right DoneParser a
da) InputHandler a
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneParser (a -> b)
df DoneParser (a -> b) -> DoneParser a -> DoneParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoneParser a
da
Done (Right a -> b
_) <#-> Scan (Left List String
xs) InputHandler a
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ List String -> DoneParser b
forall a. List String -> DoneParser a
doneMissingArg List String
xs
Done (Left DoneError
e) <#-> Scan (Left List String
_) InputHandler a
_ = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
RawParser (a -> b)
pf <#-> Done (Right a
a) = ((a -> b) -> b) -> RawParser (a -> b) -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) RawParser (a -> b)
pf
RawParser (a -> b)
_ <#-> Done (Left DoneError
e) = DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> RawParser b) -> DoneParser b -> RawParser b
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
pf :: RawParser (a -> b)
pf@(Scan EndHandler (a -> b)
endH InputHandler (a -> b)
inputH) <#-> Scan Either (List String) (DoneParser a)
endH' InputHandler a
inputH' = EndHandler b -> InputHandler b -> RawParser b
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler b
endH'' InputHandler b
inputH'' where
endH'' :: EndHandler b
endH'' = EndHandler (a -> b)
endH EndHandler (a -> b)
-> Either (List String) (DoneParser a) -> EndHandler b
forall a b. EndHandler (a -> b) -> EndHandler a -> EndHandler b
`endParallel` Either (List String) (DoneParser a)
endH'
inputH'' :: InputHandler b
inputH'' Maybe String
ms Maybe Char
mc = case InputHandler (a -> b)
inputH Maybe String
ms Maybe Char
mc of
Just Action (RawParser (a -> b))
apf -> case Either (List String) (DoneParser a)
endH' of
Right (Right a
a) -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ ((RawParser (a -> b) -> RawParser b)
-> Action (RawParser (a -> b)) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RawParser (a -> b) -> RawParser b)
-> Action (RawParser (a -> b)) -> Action (RawParser b))
-> (((a -> b) -> b) -> RawParser (a -> b) -> RawParser b)
-> ((a -> b) -> b)
-> Action (RawParser (a -> b))
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> b) -> RawParser (a -> b) -> RawParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) Action (RawParser (a -> b))
apf
Right (Left DoneError
e) -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> (DoneParser b -> Action (RawParser b))
-> DoneParser b
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action (RawParser (a -> b)) -> RawParser b -> Action (RawParser b)
forall a b. Action a -> b -> Action b
abort Action (RawParser (a -> b))
apf (RawParser b -> Action (RawParser b))
-> (DoneParser b -> RawParser b)
-> DoneParser b
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> Maybe (Action (RawParser b)))
-> DoneParser b -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ DoneError -> DoneParser b
forall a b. a -> Either a b
Left DoneError
e
Left List String
xs -> Action (RawParser b) -> Maybe (Action (RawParser b))
forall a. a -> Maybe a
Just (Action (RawParser b) -> Maybe (Action (RawParser b)))
-> (DoneParser b -> Action (RawParser b))
-> DoneParser b
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action (RawParser (a -> b)) -> RawParser b -> Action (RawParser b)
forall a b. Action a -> b -> Action b
abort Action (RawParser (a -> b))
apf (RawParser b -> Action (RawParser b))
-> (DoneParser b -> RawParser b)
-> DoneParser b
-> Action (RawParser b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoneParser b -> RawParser b
forall a. DoneParser a -> RawParser a
Done (DoneParser b -> Maybe (Action (RawParser b)))
-> DoneParser b -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ List String -> DoneParser b
forall a. List String -> DoneParser a
doneMissingArg List String
xs
Maybe (Action (RawParser (a -> b)))
Nothing -> ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (RawParser a) -> Action (RawParser b))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> ((RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b))
-> (RawParser a -> RawParser b)
-> Maybe (Action (RawParser a))
-> Maybe (Action (RawParser b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawParser a -> RawParser b)
-> Action (RawParser a) -> Action (RawParser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (RawParser (a -> b)
pf RawParser (a -> b) -> RawParser a -> RawParser b
forall (p :: * -> *) a b.
SelectiveParser p =>
p (a -> b) -> p a -> p b
<#->) (Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b)))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser b))
forall a b. (a -> b) -> a -> b
$ InputHandler a
inputH' Maybe String
ms Maybe Char
mc
Done DoneParser a
da <-|> :: RawParser a -> RawParser a -> RawParser a
<-|> RawParser a
_ = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
Scan EndHandler a
_ InputHandler a
_ <-|> Done DoneParser a
da = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
Scan EndHandler a
endH InputHandler a
inputH <-|> r :: RawParser a
r@(Scan EndHandler a
endH' InputHandler a
inputH') = EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler a
endH'' InputHandler a
inputH'' where
endH'' :: EndHandler a
endH'' = EndHandler a
endH EndHandler a -> EndHandler a -> EndHandler a
forall a. EndHandler a -> EndHandler a -> EndHandler a
`endAlternative` EndHandler a
endH'
inputH'' :: InputHandler a
inputH'' Maybe String
ms Maybe Char
mc = case InputHandler a
inputH Maybe String
ms Maybe Char
mc of
Just Action (RawParser a)
apa -> Action (RawParser a) -> Maybe (Action (RawParser a))
forall a. a -> Maybe a
Just (Action (RawParser a) -> Maybe (Action (RawParser a)))
-> Action (RawParser a) -> Maybe (Action (RawParser a))
forall a b. (a -> b) -> a -> b
$ (RawParser a -> RawParser a)
-> Action (RawParser a) -> Action (RawParser a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawParser a -> RawParser a -> RawParser a
forall (p :: * -> *) a. SelectiveParser p => p a -> p a -> p a
<-|> RawParser a
r) Action (RawParser a)
apa
Maybe (Action (RawParser a))
Nothing -> InputHandler a
inputH' Maybe String
ms Maybe Char
mc
Done DoneParser a
da <|-> :: RawParser a -> RawParser a -> RawParser a
<|-> RawParser a
_ = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
Scan EndHandler a
_ InputHandler a
_ <|-> Done DoneParser a
da = DoneParser a -> RawParser a
forall a. DoneParser a -> RawParser a
Done DoneParser a
da
l :: RawParser a
l@(Scan EndHandler a
endH InputHandler a
inputH) <|-> Scan EndHandler a
endH' InputHandler a
inputH' = EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler a
endH'' InputHandler a
inputH'' where
endH'' :: EndHandler a
endH'' = EndHandler a
endH EndHandler a -> EndHandler a -> EndHandler a
forall a. EndHandler a -> EndHandler a -> EndHandler a
`endAlternative` EndHandler a
endH'
inputH'' :: InputHandler a
inputH'' Maybe String
ms Maybe Char
mc = case InputHandler a
inputH Maybe String
ms Maybe Char
mc of
Just Action (RawParser a)
apa -> Action (RawParser a) -> Maybe (Action (RawParser a))
forall a. a -> Maybe a
Just Action (RawParser a)
apa
Maybe (Action (RawParser a))
Nothing -> ((Action (RawParser a) -> Action (RawParser a))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (RawParser a) -> Action (RawParser a))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser a)))
-> ((RawParser a -> RawParser a)
-> Action (RawParser a) -> Action (RawParser a))
-> (RawParser a -> RawParser a)
-> Maybe (Action (RawParser a))
-> Maybe (Action (RawParser a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawParser a -> RawParser a)
-> Action (RawParser a) -> Action (RawParser a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (RawParser a
l RawParser a -> RawParser a -> RawParser a
forall (p :: * -> *) a. SelectiveParser p => p a -> p a -> p a
<|->) (Maybe (Action (RawParser a)) -> Maybe (Action (RawParser a)))
-> Maybe (Action (RawParser a)) -> Maybe (Action (RawParser a))
forall a b. (a -> b) -> a -> b
$ InputHandler a
inputH' Maybe String
ms Maybe Char
mc
eof :: RawParser ()
eof = EndHandler () -> InputHandler () -> RawParser ()
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan (Either DoneError () -> EndHandler ()
forall a b. b -> Either a b
Right (Either DoneError () -> EndHandler ())
-> Either DoneError () -> EndHandler ()
forall a b. (a -> b) -> a -> b
$ () -> Either DoneError ()
forall a b. b -> Either a b
Right ()) ((Maybe Char -> Maybe (Action (RawParser ()))) -> InputHandler ()
forall a b. a -> b -> a
const ((Maybe Char -> Maybe (Action (RawParser ()))) -> InputHandler ())
-> (Maybe Char -> Maybe (Action (RawParser ()))) -> InputHandler ()
forall a b. (a -> b) -> a -> b
$ Maybe (Action (RawParser ()))
-> Maybe Char -> Maybe (Action (RawParser ()))
forall a b. a -> b -> a
const Maybe (Action (RawParser ()))
forall a. Maybe a
Nothing)
block :: String
-> (String -> Maybe (RawFollower a))
-> RawParser a
block :: String -> (String -> Maybe (RawFollower a)) -> RawParser a
block String
name String -> Maybe (RawFollower a)
f = EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler a
forall b. Either (List String) b
endH InputHandler a
forall (m :: * -> *) p.
Monad m =>
Maybe String -> p -> Maybe (Action (m a))
inputH where
endH :: Either (List String) b
endH = List String -> Either (List String) b
forall a b. a -> Either a b
Left (List String -> Either (List String) b)
-> List String -> Either (List String) b
forall a b. (a -> b) -> a -> b
$ String -> List String
forall a. a -> List a
single String
name
inputH :: Maybe String -> p -> Maybe (Action (m a))
inputH (Just String
s) p
_ = (RawFollower a -> Action (m a))
-> Maybe (RawFollower a) -> Maybe (Action (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawFollower (m a) -> Action (m a)
forall a. RawFollower a -> Action a
ConsumeBlock (RawFollower (m a) -> Action (m a))
-> (RawFollower a -> RawFollower (m a))
-> RawFollower a
-> Action (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> RawFollower a -> RawFollower (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return) (Maybe (RawFollower a) -> Maybe (Action (m a)))
-> Maybe (RawFollower a) -> Maybe (Action (m a))
forall a b. (a -> b) -> a -> b
$ String -> Maybe (RawFollower a)
f String
s
inputH Maybe String
_ p
_ = Maybe (Action (m a))
forall a. Maybe a
Nothing
short :: String
-> (Char -> Maybe a)
-> RawParser a
short :: String -> (Char -> Maybe a) -> RawParser a
short String
name Char -> Maybe a
f = EndHandler a -> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan EndHandler a
forall b. Either (List String) b
endH InputHandler a
forall (m :: * -> *) p.
Monad m =>
p -> Maybe Char -> Maybe (Action (m a))
inputH where
endH :: Either (List String) b
endH = List String -> Either (List String) b
forall a b. a -> Either a b
Left (List String -> Either (List String) b)
-> List String -> Either (List String) b
forall a b. (a -> b) -> a -> b
$ String -> List String
forall a. a -> List a
single String
name
inputH :: p -> Maybe Char -> Maybe (Action (m a))
inputH p
_ (Just Char
c) = (a -> Action (m a)) -> Maybe a -> Maybe (Action (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a -> Action (m a)
forall a. a -> Action a
ConsumeShort (m a -> Action (m a)) -> (a -> m a) -> a -> Action (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return) (Maybe a -> Maybe (Action (m a)))
-> Maybe a -> Maybe (Action (m a))
forall a b. (a -> b) -> a -> b
$ Char -> Maybe a
f Char
c
inputH p
_ Maybe Char
_ = Maybe (Action (m a))
forall a. Maybe a
Nothing
quiet :: RawParser a -> RawParser a
quiet :: RawParser a -> RawParser a
quiet (Scan (Left List String
_) InputHandler a
inputH) = Either (List String) (DoneParser a)
-> InputHandler a -> RawParser a
forall a. EndHandler a -> InputHandler a -> RawParser a
Scan (List String -> Either (List String) (DoneParser a)
forall a b. a -> Either a b
Left List String
forall a. Monoid a => a
mempty) InputHandler a
inputH
quiet RawParser a
x = RawParser a
x
match :: String
-> RawParser String
match :: String -> RawParser String
match String
s = String -> RawFollower String -> RawParser String
forall a. String -> RawFollower a -> RawParser a
matchAndFollow String
s (RawFollower String -> RawParser String)
-> RawFollower String -> RawParser String
forall a b. (a -> b) -> a -> b
$ String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
matchAndFollow :: String
-> RawFollower a
-> RawParser a
matchAndFollow :: String -> RawFollower a -> RawParser a
matchAndFollow String
s RawFollower a
fa = String -> (String -> Maybe (RawFollower a)) -> RawParser a
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block String
s ((String -> Maybe (RawFollower a)) -> RawParser a)
-> (String -> Maybe (RawFollower a)) -> RawParser a
forall a b. (a -> b) -> a -> b
$ \String
arg -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
arg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) Maybe () -> RawFollower a -> Maybe (RawFollower a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RawFollower a
fa
matchShort :: Char
-> RawParser Char
matchShort :: Char -> RawParser Char
matchShort Char
c = String -> (Char -> Maybe Char) -> RawParser Char
forall a. String -> (Char -> Maybe a) -> RawParser a
short [Char
'-', Char
c] ((Char -> Maybe Char) -> RawParser Char)
-> (Char -> Maybe Char) -> RawParser Char
forall a b. (a -> b) -> a -> b
$ \Char
c' -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Maybe () -> Char -> Maybe Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
c'
dropAll :: RawParser ()
dropAll :: RawParser ()
dropAll = (RawParser String -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> RawParser String
anyArg' String
"") RawParser () -> RawParser () -> RawParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RawParser Char -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> RawParser Char
anyShort' String
"")) RawParser () -> RawParser () -> RawParser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RawParser ()
dropAll RawParser () -> RawParser () -> RawParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> RawParser ()
forall (p :: * -> *) a. SelectiveParser p => a -> p a
orElse ()
parseRead :: Read a => String -> Either String a
parseRead :: String -> Either String a
parseRead = String -> Either String a
forall a. Read a => String -> Either String a
readEither
parseChar :: String -> Either String Char
parseChar :: String -> Either String Char
parseChar [Char
c] = Char -> Either String Char
forall a b. b -> Either a b
Right Char
c
parseChar [] = String -> Either String Char
forall a b. a -> Either a b
Left String
"expected one character, got zero"
parseChar String
s = String -> Either String Char
forall a b. a -> Either a b
Left (String -> Either String Char) -> String -> Either String Char
forall a b. (a -> b) -> a -> b
$ String
"expected one character, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
flag1 :: Option -> RawParser ()
flag1 :: Option -> RawParser ()
flag1 (Short Char
c) = RawParser Char -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RawParser Char -> RawParser ()) -> RawParser Char -> RawParser ()
forall a b. (a -> b) -> a -> b
$ Char -> RawParser Char
matchShort Char
c
flag1 (Long String
s) = RawParser String -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RawParser String -> RawParser ())
-> (String -> RawParser String) -> String -> RawParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawParser String
match (String -> RawParser ()) -> String -> RawParser ()
forall a b. (a -> b) -> a -> b
$ String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
flag' :: [OptionForm]
-> RawParser ()
flag' :: [String] -> RawParser ()
flag' [] = String -> RawParser ()
forall a. HasCallStack => String -> a
error String
"empty list of option strings"
flag' [String]
ss = [RawParser ()] -> RawParser ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([RawParser ()] -> RawParser ()) -> [RawParser ()] -> RawParser ()
forall a b. (a -> b) -> a -> b
$ (String -> RawParser ()) -> [String] -> [RawParser ()]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> RawParser ()
flag1 (Option -> RawParser ())
-> (String -> Option) -> String -> RawParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Option
parseOptionForm) [String]
ss
flagSep1 :: Option -> RawParser ()
flagSep1 :: Option -> RawParser ()
flagSep1 (Short Char
c) = RawParser String -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RawParser String -> RawParser ())
-> RawParser String -> RawParser ()
forall a b. (a -> b) -> a -> b
$ String -> RawParser String
match [Char
'-', Char
c]
flagSep1 (Long String
s) = RawParser String -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RawParser String -> RawParser ())
-> (String -> RawParser String) -> String -> RawParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawParser String
match (String -> RawParser ()) -> String -> RawParser ()
forall a b. (a -> b) -> a -> b
$ String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
flagSep' :: [OptionForm]
-> RawParser ()
flagSep' :: [String] -> RawParser ()
flagSep' [] = String -> RawParser ()
forall a. HasCallStack => String -> a
error String
"empty list of option strings"
flagSep' [String]
ss = [RawParser ()] -> RawParser ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([RawParser ()] -> RawParser ()) -> [RawParser ()] -> RawParser ()
forall a b. (a -> b) -> a -> b
$ (String -> RawParser ()) -> [String] -> [RawParser ()]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> RawParser ()
flagSep1 (Option -> RawParser ())
-> (String -> Option) -> String -> RawParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Option
parseOptionForm) [String]
ss
cutPrefix :: String -> String -> Maybe String
cutPrefix :: String -> String -> Maybe String
cutPrefix String
a String
b
| String
a String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) String
b
| Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
cutProperPrefix :: String -> String -> Maybe String
cutProperPrefix :: String -> String -> Maybe String
cutProperPrefix String
a String
b
| String
a String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b Bool -> Bool -> Bool
&& Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
la String
b
| Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
where
la :: Int
la = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a
lb :: Int
lb = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b
param1 :: Option -> String -> RawParser String
param1 :: Option -> String -> RawParser String
param1 (Short Char
c) String
metavar
= String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block
String
prefix
(\String
arg -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
arg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prefix) Maybe () -> RawFollower String -> Maybe (RawFollower String)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> RawFollower String
next String
metavar)
RawParser String -> RawParser String -> RawParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RawParser String -> RawParser String
forall a. RawParser a -> RawParser a
quiet ( String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block
(String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
metavar)
((String -> RawFollower String)
-> Maybe String -> Maybe (RawFollower String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Maybe (RawFollower String))
-> (String -> Maybe String) -> String -> Maybe (RawFollower String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
cutProperPrefix String
prefix)
)
where prefix :: String
prefix = [Char
'-', Char
c]
param1 (Long String
s) String
metavar
= String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block
String
prefix
(\String
arg -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
arg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prefix) Maybe () -> RawFollower String -> Maybe (RawFollower String)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> RawFollower String
next String
metavar)
RawParser String -> RawParser String -> RawParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RawParser String -> RawParser String
forall a. RawParser a -> RawParser a
quiet ( String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block
(String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
metavar)
((String -> RawFollower String)
-> Maybe String -> Maybe (RawFollower String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Maybe (RawFollower String))
-> (String -> Maybe String) -> String -> Maybe (RawFollower String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
cutPrefix (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"="))
)
where prefix :: String
prefix = String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
param' :: [OptionForm]
-> String
-> RawParser String
param' :: [String] -> String -> RawParser String
param' [] String
_ = String -> RawParser String
forall a. HasCallStack => String -> a
error String
"empty list of option strings"
param' [String]
opts String
metavar = [RawParser String] -> RawParser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([RawParser String] -> RawParser String)
-> [RawParser String] -> RawParser String
forall a b. (a -> b) -> a -> b
$ (String -> RawParser String) -> [String] -> [RawParser String]
forall a b. (a -> b) -> [a] -> [b]
map String -> RawParser String
f [String]
opts where
f :: String -> RawParser String
f String
opt = Option -> String -> RawParser String
param1 (String -> Option
parseOptionForm String
opt) String
metavar
paramRead' :: Read a
=> [OptionForm]
-> String
-> RawParser a
paramRead' :: [String] -> String -> RawParser a
paramRead' [String]
opts String
metavar = String -> Either String a
forall a. Read a => String -> Either String a
parseRead (String -> Either String a) -> RawParser String -> RawParser a
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> [String] -> String -> RawParser String
param' [String]
opts String
metavar
paramChar' :: [OptionForm]
-> String
-> RawParser Char
paramChar' :: [String] -> String -> RawParser Char
paramChar' [String]
opts String
metavar = String -> Either String Char
parseChar (String -> Either String Char)
-> RawParser String -> RawParser Char
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> [String] -> String -> RawParser String
param' [String]
opts String
metavar
isFreeArg :: String -> Bool
isFreeArg :: String -> Bool
isFreeArg (Char
'-':String
_) = Bool
False
isFreeArg String
_ = Bool
True
freeArg' :: String
-> RawParser String
freeArg' :: String -> RawParser String
freeArg' String
metavar = String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block String
metavar ((String -> Maybe (RawFollower String)) -> RawParser String)
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a b. (a -> b) -> a -> b
$ \String
arg -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Bool
isFreeArg String
arg) Maybe () -> RawFollower String -> Maybe (RawFollower String)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return String
arg
freeArgRead' :: Read a
=> String
-> RawParser a
freeArgRead' :: String -> RawParser a
freeArgRead' String
metavar = String -> Either String a
forall a. Read a => String -> Either String a
parseRead (String -> Either String a) -> RawParser String -> RawParser a
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawParser String
freeArg' String
metavar
freeArgChar' :: String
-> RawParser Char
freeArgChar' :: String -> RawParser Char
freeArgChar' String
metavar = String -> Either String Char
parseChar (String -> Either String Char)
-> RawParser String -> RawParser Char
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawParser String
freeArg' String
metavar
anyArg' :: String
-> RawParser String
anyArg' :: String -> RawParser String
anyArg' String
metavar = String
-> (String -> Maybe (RawFollower String)) -> RawParser String
forall a.
String -> (String -> Maybe (RawFollower a)) -> RawParser a
block String
metavar (RawFollower String -> Maybe (RawFollower String)
forall a. a -> Maybe a
Just (RawFollower String -> Maybe (RawFollower String))
-> (String -> RawFollower String)
-> String
-> Maybe (RawFollower String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawFollower String
forall (m :: * -> *) a. Monad m => a -> m a
return)
anyArgRead' :: Read a
=> String
-> RawParser a
anyArgRead' :: String -> RawParser a
anyArgRead' String
metavar = String -> Either String a
forall a. Read a => String -> Either String a
parseRead (String -> Either String a) -> RawParser String -> RawParser a
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawParser String
anyArg' String
metavar
anyArgChar' :: String
-> RawParser Char
anyArgChar' :: String -> RawParser Char
anyArgChar' String
metavar = String -> Either String Char
parseChar (String -> Either String Char)
-> RawParser String -> RawParser Char
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawParser String
anyArg' String
metavar
anyShort' :: String
-> RawParser Char
anyShort' :: String -> RawParser Char
anyShort' String
metavar = String -> (Char -> Maybe Char) -> RawParser Char
forall a. String -> (Char -> Maybe a) -> RawParser a
short String
metavar Char -> Maybe Char
forall a. a -> Maybe a
Just
multiParam1 :: Option -> RawFollower a -> RawParser a
multiParam1 :: Option -> RawFollower a -> RawParser a
multiParam1 (Short Char
c) = String -> RawFollower a -> RawParser a
forall a. String -> RawFollower a -> RawParser a
matchAndFollow [Char
'-', Char
c]
multiParam1 (Long String
s) = String -> RawFollower a -> RawParser a
forall a. String -> RawFollower a -> RawParser a
matchAndFollow (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
multiParam' :: [OptionForm]
-> RawFollower a
-> RawParser a
multiParam' :: [String] -> RawFollower a -> RawParser a
multiParam' [] RawFollower a
_ = String -> RawParser a
forall a. HasCallStack => String -> a
error String
"empty list of option strings"
multiParam' [String]
opts RawFollower a
ra = [RawParser a] -> RawParser a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([RawParser a] -> RawParser a) -> [RawParser a] -> RawParser a
forall a b. (a -> b) -> a -> b
$ (String -> RawParser a) -> [String] -> [RawParser a]
forall a b. (a -> b) -> [a] -> [b]
map String -> RawParser a
f [String]
opts where
f :: String -> RawParser a
f String
opt = Option -> RawFollower a -> RawParser a
forall a. Option -> RawFollower a -> RawParser a
multiParam1 (String -> Option
parseOptionForm String
opt) RawFollower a
ra
nextRead :: Read a
=> String
-> RawFollower a
nextRead :: String -> RawFollower a
nextRead String
v = String -> Either String a
forall a. Read a => String -> Either String a
parseRead (String -> Either String a) -> RawFollower String -> RawFollower a
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawFollower String
next String
v
nextChar :: String
-> RawFollower Char
nextChar :: String -> RawFollower Char
nextChar String
v = String -> Either String Char
parseChar (String -> Either String Char)
-> RawFollower String -> RawFollower Char
forall (f :: * -> *) a b.
FunctorFail f =>
(a -> Either String b) -> f a -> f b
<$?> String -> RawFollower String
next String
v
eject :: RawParser a
-> RawParser b
-> RawParser (Either b a)
eject :: RawParser a -> RawParser b -> RawParser (Either b a)
eject RawParser a
a RawParser b
b = (a -> Either b a
forall a b. b -> Either a b
Right (a -> Either b a) -> RawParser a -> RawParser (Either b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawParser a
a RawParser (Either b a) -> RawParser () -> RawParser (Either b a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RawParser ()
forall (p :: * -> *). SelectiveParser p => p ()
eof) RawParser (Either b a)
-> RawParser (Either b a) -> RawParser (Either b a)
forall (p :: * -> *) a. SelectiveParser p => p a -> p a -> p a
<-|> RawParser (Either b a) -> RawParser (Either b a)
forall a. RawParser a -> RawParser a
quiet (b -> Either b a
forall a b. a -> Either a b
Left (b -> Either b a) -> RawParser b -> RawParser (Either b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawParser b
b RawParser (Either b a) -> RawParser () -> RawParser (Either b a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RawParser ()
dropAll)
withVersion' :: String
-> RawParser a
-> RawParser (Either String a)
withVersion' :: String -> RawParser a -> RawParser (Either String a)
withVersion' String
s RawParser a
pa = RawParser a -> RawParser String -> RawParser (Either String a)
forall a b. RawParser a -> RawParser b -> RawParser (Either b a)
eject RawParser a
pa (RawParser String -> RawParser (Either String a))
-> RawParser String -> RawParser (Either String a)
forall a b. (a -> b) -> a -> b
$ [String] -> RawParser ()
flag' [String
"--version"] RawParser () -> String -> RawParser String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String
s
beforeDashes :: RawParser a
-> RawParser a
beforeDashes :: RawParser a -> RawParser a
beforeDashes RawParser a
pa = RawParser a
pa RawParser a -> RawParser () -> RawParser a
forall (p :: * -> *) a b. SelectiveParser p => p a -> p b -> p a
<-# (RawParser String -> RawParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> RawParser String
match String
"--") RawParser () -> RawParser () -> RawParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> RawParser ()
forall (p :: * -> *) a. SelectiveParser p => a -> p a
orElse ())
runParserIO :: IOOps m => RawParser a -> [String] -> m a
runParserIO :: RawParser a -> [String] -> m a
runParserIO RawParser a
pa [String]
args = case RawParser a -> [String] -> Either ParserError a
forall a. RawParser a -> [String] -> Either ParserError a
runParser RawParser a
pa [String]
args of
Right a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Left ParserError
e -> do
String
name <- m String
forall (m :: * -> *). IOOps m => m String
getProgName
String -> m a
forall (m :: * -> *) a. IOOps m => String -> m a
die (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParserError -> String
formatParserError ParserError
e
parseArgs :: IOOps m => RawParser a -> m a
parseArgs :: RawParser a -> m a
parseArgs RawParser a
pa = m [String]
forall (m :: * -> *). IOOps m => m [String]
getArgs m [String] -> ([String] -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RawParser a -> [String] -> m a
forall (m :: * -> *) a. IOOps m => RawParser a -> [String] -> m a
runParserIO RawParser a
pa
withVersionIO' :: IOOps m
=> String
-> RawParser (m a)
-> RawParser (m a)
withVersionIO' :: String -> RawParser (m a) -> RawParser (m a)
withVersionIO' String
s = (Either String (m a) -> m a)
-> RawParser (Either String (m a)) -> RawParser (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a)
-> (Either String (m a) -> m (m a)) -> Either String (m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (m a) -> m (m a)
forall (m :: * -> *) a. IOOps m => Either String a -> m a
versionToIO) (RawParser (Either String (m a)) -> RawParser (m a))
-> (RawParser (m a) -> RawParser (Either String (m a)))
-> RawParser (m a)
-> RawParser (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawParser (m a) -> RawParser (Either String (m a))
forall a. String -> RawParser a -> RawParser (Either String a)
withVersion' String
s