{-|
Module      : Options.OptStream.Raw
Copyright   : (c) Dan Shved, 2022
License     : BSD-3
Maintainer  : danshved@gmail.com
Stability   : experimental

This module contains 'RawParser' and 'RawFollower', which are the actual types
used by 'Options.OptStream.Parser' and 'Opteans.OptStream.Follower' internally.

'RawParser' is the core type of the /optstream/ library. It provides a
twice-applicative and once-monadic interface for building command line parsers.
It takes care of the parsing itself, but doesn't deal with higher-level
features such as help generation. 'Options.OptStream.Parser' is a (rather thin)
wrapper built on top of 'RawParser' in order to provide basic handling of
@--help@. You can build your own interface on top of 'RawParser' to provide
more sophisticated features.
-}
module Options.OptStream.Raw
  ( module Options.OptStream.Classes
    -- * Parsers
  , RawParser
  , runParser
  , runParserIO
  , parseArgs

    -- * Atomic parsers
  , OptionForm
  , isLegalOptionForm
    -- ** Flags
  , flag'
  , flagSep'
    -- ** Parameters
  , param'
  , paramRead'
  , paramChar'
    -- ** Free arguments
  , freeArg'
  , freeArgRead'
  , freeArgChar'
  , anyArg'
  , anyArgRead'
  , anyArgChar'
    -- ** Multi-parameters
  , multiParam'
  , RawFollower
  , next
  , nextRead
  , nextChar
  , nextMetavar

    -- * Utilities
  , withVersion'
  , withVersionIO'
  , beforeDashes

    -- * Low-level parsers
  , block
  , short
  , match
  , matchAndFollow
  , matchShort
  , quiet
  , eject

    -- * Errors
  , 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


-- * Errors

-- At which token a DoneError occurred.
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)

-- | An error returned by 'Options.OptStream.runParser'. There are three kinds of errors:
--
--   * An unexpected command line argument. This means that the top-level
--   parser skipped (didn't consume) an input token (a command-line argument or
--   a 'Options.OptStream.short' flag inside an argument).
--
--   * A missing argument. This means that either the top-level parser refused
--   to consume EOF, or that EOF was reached when a
--   'Options.OptStream.Follower' was holding the stream and wanted more input.
--   The error message will generally contain a list of possible items missing
--   (flags or metavariables).
--
--   * A custom error thrown with e.g. 'failA' or 'fmapOrFail'.
data ParserError
  -- The top-level parser didn't accept an argument.
  = UnexpectedArg String
  -- The top-level parser didn't accept a short flag.
  | UnexpectedChar Char String
  -- A Follower reached the end of input but wants more.
  | MissingArgAfter [String] String
  -- An argument is missing (a Parser refused to consume EOF).
  | MissingArg Context [String]
  -- A custom error was thrown by 'fail'.
  | 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)

-- | Formats a 'ParserError' to a human-readable string.
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


-- * RawFollower monad

-- | A 'RawFollower' consumes zero or more strings from a stream and then
-- produces a result of type @a@. This is the type that
-- 'Options.OptStream.Follower' uses internally. The differences between
-- 'RawFollower' and 'Options.OptStream.Follower' are:
--
--   * A 'Options.OptStream.Follower' has a help string attached to it, a
--   'RawFollower' doesn't.
--
--   * 'RawFollower' is a 'Monad', whereas 'Options.OptStream.Follower' is only
--   an 'Applicative'.
data RawFollower a
  = FollowerDone (Either String a)
  | FollowerNext String (String -> RawFollower a)

data FollowerError
  = FollowerMissingArg String
  | FollowerCustomError Context String

-- | See 'Options.OptStream.nextMetavar'.
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

-- Left means the reader consumed all input and wants more.
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

-- | See 'Options.OptStream.next'
next :: String
        -- ^ Metavariable for error messages.
     -> 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


-- * Parser monad

-- | An error that a Done parser can contain.
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

-- | Represents a parser that has finished its job. It can be either a 'Left'
-- if the parser failed or a 'Right' if it succeeded.
type DoneParser a = Either DoneError a

-- | An EOF handler. Represents what the parser will do if the next token it
-- receives is EOF. The possibilities are:
--
--   * Refuse to consume EOF (a 'Left' value). In this case the 'Left' contains
--   a list of suggestions for which items the user could supply in order for
--   the parser to make progress.
--
--   * Consume EOF (a 'Right' value) and finish the parse. In this case the
--   'Right' contains the final state of the parser.
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))

-- | A 'RawParser' processes part of a stream of command line arguments and
-- produces an output value of type @a@. 'RawParser' is the type that
-- 'Options.OptStream.Parser' uses internally. The differences between these
-- two types are:
--
--   * A 'Options.OptStream.Parser' has a 'Options.OptStream.Help.Help' object
--   attached to it. A 'RawParser' doesn't.
--
--   * 'RawParser' is a 'Monad', whereas 'Options.OptStream.Parser' is only an
--   'Applicative'.
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

-- | See 'Options.OptStream.runParser'.
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


-- ** Instances

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)



-- ** Primitive parsers

-- | See 'Options.OptStream.block'.
block :: String
         -- ^ Block name for "missing argument" error messages. Arbitrary
         -- string.
      -> (String -> Maybe (RawFollower a))
         -- ^ A function that decides whether to skip or consume a command line
         -- argument.
      -> RawParser a
         -- ^ A 'RawParser' that consumes one consecutive block of command line
         -- arguments.
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

-- TODO: don't consume the long version once runParser is updated.
-- | See 'Options.OptStream.short'.
short :: String
         -- ^ Short flag name for "missing argument" error messages. Arbitrary
         -- string.
      -> (Char -> Maybe a)
         -- ^ A function that decides whether to skip or consume a short flag.
      -> RawParser a
         -- ^ A 'RawParser' that consumes one short flag.
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

-- | See 'Options.OptStream.quiet'.
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


-- ** Matchers

-- | See 'Options.OptStream.match'.
match :: String
         -- ^ The exact command line argument to match.
      -> RawParser String
         -- ^ A parser that finishes after matching and consuming the argument.
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

-- | See 'Options.OptStream.matchAndFollow'.
matchAndFollow :: String
                  -- ^ Command line argument that starts a block.
               -> RawFollower a
                  -- ^ A follower that consumes the rest of the block.
               -> 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

-- | See 'Options.OptStream.matchShort'.
matchShort :: Char
              -- ^ A short flag, e.g. @\'x\'@ will match @-x@ or an occurence
              -- of @\'x\'@ in a bundle of short flags like @-xyz@.
           -> 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 ()


-- ** Parsers for parameter values

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)

-- ** High level matchers


-- *** Flag

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

-- | See 'Options.OptStream.flag''.
flag' :: [OptionForm]
         -- ^ Flag forms, e.g. @["-f", "--foo"]@.
      -> RawParser ()
         -- ^ A parser that succeeds upon consuming the flag.
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

-- | See 'Options.OptStream.flagSep''.
flagSep' :: [OptionForm]
            -- ^ Flag forms, e.g. @["-f", "--foo"]@.
         -> RawParser ()
            -- ^ A parser that succeeds upon consuming the flag.
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


-- *** Param

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

-- | See 'Options.OptStream.param''.
param' :: [OptionForm]
          -- ^ All parameter forms, e.g. @["-n", "--name"]@.
       -> String
          -- ^ Metavariable for error messages.
       -> RawParser String
          -- ^ A parser that returns the parameter value.
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

-- | See 'Options.OptStream.paramRead''.
paramRead' :: Read a
           => [OptionForm]
              -- ^ All parameter forms, e.g. @["-n", "--number"]@.
           -> String
              -- ^ Metavariable for error messages.
           -> RawParser a
              -- ^ A parser that returns the parsed parameter value.
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

-- | See 'Options.OptStream.paramChar''.
paramChar' :: [OptionForm]
              -- ^ All parameter forms, e.g. @["-s", "--separator"]@.
           -> String
              -- ^ Metavariable for error messages.
           -> RawParser Char
              -- ^ A parser that returns the parsed parameter value.
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


-- *** Free arguments

isFreeArg :: String -> Bool
isFreeArg :: String -> Bool
isFreeArg (Char
'-':String
_) = Bool
False
isFreeArg String
_ = Bool
True

-- | See 'Options.OptStream.freeArg''.
freeArg' :: String
            -- ^ Metavariable for error messages (arbitrary string).
         -> RawParser String
            -- ^ Parser that consumes and returns the first free argument it
            -- sees.
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

-- | See 'Options.OptStream.freeArgRead''.
freeArgRead' :: Read a
             => String
                -- ^ Metavariable for error messages (arbitrary string).
             -> RawParser a
                -- ^ Parser that consumes the first free argument it sees and
                -- parses it down to type @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

-- | See 'Options.OptStream.freeArgChar''.
freeArgChar' :: String
                -- ^ Metavariable for error messages.
             -> RawParser Char
                -- ^ Parser that consumes the first free argument it sees and
                -- parses it down to a 'Data.Char.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

-- | See 'Options.OptStream.anyArg''.
anyArg' :: String
           -- ^ Metavariable for error messages.
        -> RawParser String
           -- ^ Parser that consumes and returns the first argument it sees.
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)

-- | See 'Options.OptStream.anyArgRead''.
anyArgRead' :: Read a
            => String
               -- ^ Metavariable for error messages.
            -> RawParser a
               -- ^ Parser that consumes the first argument it sees and parses
               -- it down to type @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

-- | See 'Options.OptStream.anyArgChar''.
anyArgChar' :: String
               -- ^ Metavariable for error messages.
            -> RawParser Char
               -- ^ Parser that consumes the first argument it sees and parses
               -- it down to a '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

-- | Consumes any short flag. Not exported for now as usage is unclear.
anyShort' :: String
             -- ^ Metavariable for error messages.
          -> RawParser Char
             -- ^ Parser that consumes and returns the first short flag it
             -- sees.
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

-- *** Multi-parameters

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)

-- | See 'Options.OptStream.multiParam''.
multiParam' :: [OptionForm]
              -- ^ All multi-parameter forms, e.g. @["-p", "--person"]@.
            -> RawFollower a
              -- ^ How to process the following arguments.
            -> RawParser a
              -- ^ A parser that consumes the option form and the following
              -- arguments.
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

-- | See 'Options.OptStream.nextRead'.
nextRead :: Read a
         => String
            -- ^ Metavariable for error messages.
         -> 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

-- | See 'Options.OptStream.nextChar'.
nextChar :: String
            -- ^ Metavariable for error messages.
         -> 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


-- ** Utilities

-- | See 'Options.OptStream.eject'.
eject :: RawParser a
         -- ^ An existing parser.
      -> RawParser b
         -- ^ A parser that may trigger an ejection.
      -> 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)

-- | See 'Options.OptStream.withVersion''.
withVersion' :: String
                -- ^ Version info to be shown to the user.
             -> RawParser a
                -- ^ An existing 'RawParser'.
             -> RawParser (Either String a)
                -- ^ A wrapper 'RawParser' that returns either @a@ or the given
                -- version string.
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

-- | See 'Options.OptStream.beforeDashes'.
beforeDashes :: RawParser a
                -- ^ An existing 'RawParser'.
             -> RawParser a
                -- ^ A wrapper that handles @--@.
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 ())


-- ** IO helpers

-- | See 'Options.OptStream.runParserIO'.
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

-- | See 'Options.OptStream.parseArgs'.
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

-- | See 'Options.OptStream.withVersionIO''.
withVersionIO' :: IOOps m
               => String
                  -- ^ Version information to show to the user.
               -> RawParser (m a)
                  -- ^ An existing 'RawParser'.
               -> RawParser (m a)
                  -- ^ A wrapper that handles @--version@.
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