-- | 'ParserT' is the core monad transformer for parsing.
module SimpleParser.Parser
  ( ParserT (..)
  , Parser
  , runParser
  , filterParser
  , reflectParser
  , branchParser
  , suppressParser
  , defaultParser
  , optionalParser
  , silenceParser
  , greedyStarParser
  , greedyStarParser_
  , greedyPlusParser
  , greedyPlusParser_
  ) where

import Control.Applicative (Alternative (..), liftA2)
import Control.Monad (MonadPlus (..), ap, (>=>))
import Control.Monad.Except (MonadError (..))
import Control.Monad.Identity (Identity (..))
import Control.Monad.State (MonadState (..))
import Control.Monad.Trans (MonadTrans (..))
import Data.Foldable (toList)
import ListT (ListT (..))
import qualified ListT
import SimpleParser.Result (ParseResult (..), ParseValue (..))

-- | A 'ParserT' is a state/error/list transformer useful for parsing.
-- All MTL instances are for this transformer only. If, for example, your effect
-- has its own 'MonadState' instance, you'll have to use 'lift get' instead of 'get'.
newtype ParserT e s m a = ParserT { ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT :: s -> ListT m (ParseResult e s a) }
  deriving (a -> ParserT e s m b -> ParserT e s m a
(a -> b) -> ParserT e s m a -> ParserT e s m b
(forall a b. (a -> b) -> ParserT e s m a -> ParserT e s m b)
-> (forall a b. a -> ParserT e s m b -> ParserT e s m a)
-> Functor (ParserT e s m)
forall a b. a -> ParserT e s m b -> ParserT e s m a
forall a b. (a -> b) -> ParserT e s m a -> ParserT e s m b
forall e s (m :: * -> *) a b.
Functor m =>
a -> ParserT e s m b -> ParserT e s m a
forall e s (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParserT e s m a -> ParserT e s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ParserT e s m b -> ParserT e s m a
$c<$ :: forall e s (m :: * -> *) a b.
Functor m =>
a -> ParserT e s m b -> ParserT e s m a
fmap :: (a -> b) -> ParserT e s m a -> ParserT e s m b
$cfmap :: forall e s (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParserT e s m a -> ParserT e s m b
Functor)

-- | Use 'Parser' if you have no need for other monadic effects.
type Parser e s a = ParserT e s Identity a

instance Monad m => Applicative (ParserT e s m) where
  pure :: a -> ParserT e s m a
pure a
a = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (ParseResult e s a -> ListT m (ParseResult e s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult e s a -> ListT m (ParseResult e s a))
-> (s -> ParseResult e s a) -> s -> ListT m (ParseResult e s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseValue e a -> s -> ParseResult e s a
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (a -> ParseValue e a
forall e a. a -> ParseValue e a
ParseSuccess a
a))
  <*> :: ParserT e s m (a -> b) -> ParserT e s m a -> ParserT e s m b
(<*>) = ParserT e s m (a -> b) -> ParserT e s m a -> ParserT e s m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (ParserT e s m) where
  return :: a -> ParserT e s m a
return = a -> ParserT e s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ParserT e s m a
parser >>= :: ParserT e s m a -> (a -> ParserT e s m b) -> ParserT e s m b
>>= a -> ParserT e s m b
f = (s -> ListT m (ParseResult e s b)) -> ParserT e s m b
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser (s -> ListT m (ParseResult e s a))
-> (ParseResult e s a -> ListT m (ParseResult e s b))
-> s
-> ListT m (ParseResult e s b)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ParseResult e s a -> ListT m (ParseResult e s b)
go) where
    go :: ParseResult e s a -> ListT m (ParseResult e s b)
go (ParseResult ParseValue e a
v s
t) =
      case ParseValue e a
v of
        ParseError e
e -> ParseResult e s b -> ListT m (ParseResult e s b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseValue e b -> s -> ParseResult e s b
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (e -> ParseValue e b
forall e a. e -> ParseValue e a
ParseError e
e) s
t)
        ParseSuccess a
a -> ParserT e s m b -> s -> ListT m (ParseResult e s b)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT (a -> ParserT e s m b
f a
a) s
t

instance Monad m => Alternative (ParserT e s m) where
  empty :: ParserT e s m a
empty = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (ListT m (ParseResult e s a) -> s -> ListT m (ParseResult e s a)
forall a b. a -> b -> a
const ListT m (ParseResult e s a)
forall (f :: * -> *) a. Alternative f => f a
empty)
  ParserT e s m a
first <|> :: ParserT e s m a -> ParserT e s m a -> ParserT e s m a
<|> ParserT e s m a
second = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\s
s -> ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
first s
s ListT m (ParseResult e s a)
-> ListT m (ParseResult e s a) -> ListT m (ParseResult e s a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
second s
s)

instance Monad m => MonadPlus (ParserT e s m) where
  mzero :: ParserT e s m a
mzero = ParserT e s m a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: ParserT e s m a -> ParserT e s m a -> ParserT e s m a
mplus = ParserT e s m a -> ParserT e s m a -> ParserT e s m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monad m => MonadError e (ParserT e s m) where
  throwError :: e -> ParserT e s m a
throwError e
e = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (ParseResult e s a -> ListT m (ParseResult e s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult e s a -> ListT m (ParseResult e s a))
-> (s -> ParseResult e s a) -> s -> ListT m (ParseResult e s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseValue e a -> s -> ParseResult e s a
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (e -> ParseValue e a
forall e a. e -> ParseValue e a
ParseError e
e))
  -- TODO(ejconlon) Implement directly by unwrapping?
  catchError :: ParserT e s m a -> (e -> ParserT e s m a) -> ParserT e s m a
catchError ParserT e s m a
parser e -> ParserT e s m a
handler = do
    ParseValue e a
r <- ParserT e s m a -> ParserT e s m (ParseValue e a)
forall (m :: * -> *) e s a.
Monad m =>
ParserT e s m a -> ParserT e s m (ParseValue e a)
reflectParser ParserT e s m a
parser
    case ParseValue e a
r of
      ParseError e
e -> e -> ParserT e s m a
handler e
e
      ParseSuccess a
a -> a -> ParserT e s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

instance Monad m => MonadState s (ParserT e s m) where
  get :: ParserT e s m s
get = (s -> ListT m (ParseResult e s s)) -> ParserT e s m s
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\s
s -> ParseResult e s s -> ListT m (ParseResult e s s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseValue e s -> s -> ParseResult e s s
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (s -> ParseValue e s
forall e a. a -> ParseValue e a
ParseSuccess s
s) s
s))
  put :: s -> ParserT e s m ()
put s
t = (s -> ListT m (ParseResult e s ())) -> ParserT e s m ()
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (ListT m (ParseResult e s ()) -> s -> ListT m (ParseResult e s ())
forall a b. a -> b -> a
const (ParseResult e s () -> ListT m (ParseResult e s ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseValue e () -> s -> ParseResult e s ()
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (() -> ParseValue e ()
forall e a. a -> ParseValue e a
ParseSuccess ()) s
t)))
  state :: (s -> (a, s)) -> ParserT e s m a
state s -> (a, s)
f = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\s
s -> let (a
a, s
t) = s -> (a, s)
f s
s in ParseResult e s a -> ListT m (ParseResult e s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseValue e a -> s -> ParseResult e s a
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (a -> ParseValue e a
forall e a. a -> ParseValue e a
ParseSuccess a
a) s
t))

instance MonadTrans (ParserT e s) where
  lift :: m a -> ParserT e s m a
lift m a
ma = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\s
s -> m (ParseResult e s a) -> ListT m (ParseResult e s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((a -> ParseResult e s a) -> m a -> m (ParseResult e s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> ParseValue e a -> s -> ParseResult e s a
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (a -> ParseValue e a
forall e a. a -> ParseValue e a
ParseSuccess a
a) s
s) m a
ma))

-- | Runs a non-effectful parser from an inital state and collects all results.
runParser :: Parser e s a -> s -> [ParseResult e s a]
runParser :: Parser e s a -> s -> [ParseResult e s a]
runParser Parser e s a
m s
s = Identity [ParseResult e s a] -> [ParseResult e s a]
forall a. Identity a -> a
runIdentity (ListT Identity (ParseResult e s a) -> Identity [ParseResult e s a]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList (Parser e s a -> s -> ListT Identity (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT Parser e s a
m s
s))

-- | Filters parse results
filterParser :: Monad m => (a -> Bool) -> ParserT e s m a -> ParserT e s m a
filterParser :: (a -> Bool) -> ParserT e s m a -> ParserT e s m a
filterParser a -> Bool
f ParserT e s m a
parser = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
 -> ListT m (ParseResult e s a))
-> (s
    -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> s
-> ListT m (ParseResult e s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go (ListT m (ParseResult e s a)
 -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> (s -> ListT m (ParseResult e s a))
-> s
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser) where
  go :: ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. Maybe a
Nothing
      Just (r :: ParseResult e s a
r@(ParseResult ParseValue e a
v s
_), ListT m (ParseResult e s a)
rest) ->
        case ParseValue e a
v of
          ParseSuccess a
a | Bool -> Bool
not (a -> Bool
f a
a) -> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ListT m (ParseResult e s a)
rest
          ParseValue e a
_ -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s a, ListT m (ParseResult e s a))
-> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. a -> Maybe a
Just (ParseResult e s a
r, m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ListT m (ParseResult e s a)
rest)))

-- | A kind of "catch" that returns all results, success and failure.
reflectParser :: Monad m => ParserT e s m a -> ParserT e s m (ParseValue e a)
reflectParser :: ParserT e s m a -> ParserT e s m (ParseValue e a)
reflectParser ParserT e s m a
parser = (s -> ListT m (ParseResult e s (ParseValue e a)))
-> ParserT e s m (ParseValue e a)
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (m (Maybe
     (ParseResult e s (ParseValue e a),
      ListT m (ParseResult e s (ParseValue e a))))
-> ListT m (ParseResult e s (ParseValue e a))
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe
      (ParseResult e s (ParseValue e a),
       ListT m (ParseResult e s (ParseValue e a))))
 -> ListT m (ParseResult e s (ParseValue e a)))
-> (s
    -> m (Maybe
            (ParseResult e s (ParseValue e a),
             ListT m (ParseResult e s (ParseValue e a)))))
-> s
-> ListT m (ParseResult e s (ParseValue e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m (ParseResult e s a)
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
forall (m :: * -> *) e s a e.
Monad m =>
ListT m (ParseResult e s a)
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
go (ListT m (ParseResult e s a)
 -> m (Maybe
         (ParseResult e s (ParseValue e a),
          ListT m (ParseResult e s (ParseValue e a)))))
-> (s -> ListT m (ParseResult e s a))
-> s
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser) where
  go :: ListT m (ParseResult e s a)
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
go ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> Maybe
  (ParseResult e s (ParseValue e a),
   ListT m (ParseResult e s (ParseValue e a)))
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (ParseResult e s (ParseValue e a),
   ListT m (ParseResult e s (ParseValue e a)))
forall a. Maybe a
Nothing
      Just (ParseResult ParseValue e a
v s
t, ListT m (ParseResult e s a)
rest) ->
        Maybe
  (ParseResult e s (ParseValue e a),
   ListT m (ParseResult e s (ParseValue e a)))
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s (ParseValue e a),
 ListT m (ParseResult e s (ParseValue e a)))
-> Maybe
     (ParseResult e s (ParseValue e a),
      ListT m (ParseResult e s (ParseValue e a)))
forall a. a -> Maybe a
Just (ParseValue e (ParseValue e a)
-> s -> ParseResult e s (ParseValue e a)
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (ParseValue e a -> ParseValue e (ParseValue e a)
forall e a. a -> ParseValue e a
ParseSuccess ParseValue e a
v) s
t, m (Maybe
     (ParseResult e s (ParseValue e a),
      ListT m (ParseResult e s (ParseValue e a))))
-> ListT m (ParseResult e s (ParseValue e a))
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (ListT m (ParseResult e s a)
-> m (Maybe
        (ParseResult e s (ParseValue e a),
         ListT m (ParseResult e s (ParseValue e a))))
go ListT m (ParseResult e s a)
rest)))

-- | Combines the results of many parsers.
branchParser :: (Foldable f, Monad m) => f (ParserT e s m a) -> ParserT e s m a
branchParser :: f (ParserT e s m a) -> ParserT e s m a
branchParser = [ParserT e s m a] -> ParserT e s m a
forall (m :: * -> *) e t a.
Monad m =>
[ParserT e t m a] -> ParserT e t m a
start ([ParserT e s m a] -> ParserT e s m a)
-> (f (ParserT e s m a) -> [ParserT e s m a])
-> f (ParserT e s m a)
-> ParserT e s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (ParserT e s m a) -> [ParserT e s m a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList where
  start :: [ParserT e t m a] -> ParserT e t m a
start [ParserT e t m a]
ps =
    case [ParserT e t m a]
ps of
      [] -> ParserT e t m a
forall (f :: * -> *) a. Alternative f => f a
empty
      ParserT e t m a
q:[ParserT e t m a]
qs -> (t -> ListT m (ParseResult e t a)) -> ParserT e t m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\t
s -> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
-> ListT m (ParseResult e t a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (t
-> ParserT e t m a
-> [ParserT e t m a]
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
forall (m :: * -> *) t e a.
Monad m =>
t
-> ParserT e t m a
-> [ParserT e t m a]
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
run t
s ParserT e t m a
q [ParserT e t m a]
qs))
  run :: t
-> ParserT e t m a
-> [ParserT e t m a]
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
run t
s ParserT e t m a
q [ParserT e t m a]
qs = do
    Maybe (ParseResult e t a, ListT m (ParseResult e t a))
m <- ListT m (ParseResult e t a)
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons (ParserT e t m a -> t -> ListT m (ParseResult e t a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e t m a
q t
s)
    case Maybe (ParseResult e t a, ListT m (ParseResult e t a))
m of
      Maybe (ParseResult e t a, ListT m (ParseResult e t a))
Nothing ->
        case [ParserT e t m a]
qs of
          [] -> Maybe (ParseResult e t a, ListT m (ParseResult e t a))
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult e t a, ListT m (ParseResult e t a))
forall a. Maybe a
Nothing
          ParserT e t m a
r:[ParserT e t m a]
rs -> t
-> ParserT e t m a
-> [ParserT e t m a]
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
run t
s ParserT e t m a
r [ParserT e t m a]
rs
      Just (ParseResult e t a
a, ListT m (ParseResult e t a)
rest) -> Maybe (ParseResult e t a, ListT m (ParseResult e t a))
-> m (Maybe (ParseResult e t a, ListT m (ParseResult e t a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e t a, ListT m (ParseResult e t a))
-> Maybe (ParseResult e t a, ListT m (ParseResult e t a))
forall a. a -> Maybe a
Just (ParseResult e t a
a, ListT m (ParseResult e t a)
rest))

-- | If the parse results in ANY successes, keep only those. Otherwise return all failures.
-- This may block indefinitely as it awaits either the end of the parser or its first success.
suppressParser :: Monad m => ParserT e s m a -> ParserT e s m a
suppressParser :: ParserT e s m a -> ParserT e s m a
suppressParser ParserT e s m a
parser = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
 -> ListT m (ParseResult e s a))
-> (s
    -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> s
-> ListT m (ParseResult e s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseResult e s a]
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) e s a.
Monad m =>
[ParseResult e s a]
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go [] (ListT m (ParseResult e s a)
 -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> (s -> ListT m (ParseResult e s a))
-> s
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser) where
  go :: [ParseResult e s a]
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ![ParseResult e s a]
acc ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> [ParseResult e s a]
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a.
Applicative m =>
[a] -> m (Maybe (a, ListT m a))
returnErr ([ParseResult e s a] -> [ParseResult e s a]
forall a. [a] -> [a]
reverse [ParseResult e s a]
acc)
      Just (r :: ParseResult e s a
r@(ParseResult ParseValue e a
v s
_), ListT m (ParseResult e s a)
rest) ->
        case ParseValue e a
v of
          ParseError e
_ -> [ParseResult e s a]
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go (ParseResult e s a
rParseResult e s a -> [ParseResult e s a] -> [ParseResult e s a]
forall a. a -> [a] -> [a]
:[ParseResult e s a]
acc) ListT m (ParseResult e s a)
rest
          ParseSuccess a
_ -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s a, ListT m (ParseResult e s a))
-> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. a -> Maybe a
Just (ParseResult e s a
r, m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) e s a.
Monad m =>
ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
filterOk ListT m (ParseResult e s a)
rest)))

  returnErr :: [a] -> m (Maybe (a, ListT m a))
returnErr [a]
racc =
    case [a]
racc of
      [] -> Maybe (a, ListT m a) -> m (Maybe (a, ListT m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, ListT m a)
forall a. Maybe a
Nothing
      a
r:[a]
rs -> Maybe (a, ListT m a) -> m (Maybe (a, ListT m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, ListT m a) -> Maybe (a, ListT m a)
forall a. a -> Maybe a
Just (a
r, m (Maybe (a, ListT m a)) -> ListT m a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT ([a] -> m (Maybe (a, ListT m a))
returnErr [a]
rs)))

  filterOk :: ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
filterOk ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. Maybe a
Nothing
      Just (r :: ParseResult e s a
r@(ParseResult ParseValue e a
v s
_), ListT m (ParseResult e s a)
rest) ->
        let nextListt :: m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt = ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
filterOk ListT m (ParseResult e s a)
rest
        in case ParseValue e a
v of
          ParseError e
_ -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt
          ParseSuccess a
_ -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s a, ListT m (ParseResult e s a))
-> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. a -> Maybe a
Just (ParseResult e s a
r, m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt))

-- | If the parser yields no results (success or failure), yield a given value.
defaultParser :: Monad m => a -> ParserT e s m a -> ParserT e s m a
defaultParser :: a -> ParserT e s m a -> ParserT e s m a
defaultParser a
def ParserT e s m a
parser = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (\s
s -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (s
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go s
s (ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser s
s))) where
  go :: s
-> ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go s
s ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s a, ListT m (ParseResult e s a))
-> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. a -> Maybe a
Just (ParseValue e a -> s -> ParseResult e s a
forall e s a. ParseValue e a -> s -> ParseResult e s a
ParseResult (a -> ParseValue e a
forall e a. a -> ParseValue e a
ParseSuccess a
def) s
s, ListT m (ParseResult e s a)
forall (f :: * -> *) a. Alternative f => f a
empty))
      Just (ParseResult e s a, ListT m (ParseResult e s a))
_ -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m

-- | A parser that yields 'Nothing' if there are no results (success or failure),
-- otherwise wrapping successes in 'Just'.
optionalParser :: Monad m => ParserT e s m a -> ParserT e s m (Maybe a)
optionalParser :: ParserT e s m a -> ParserT e s m (Maybe a)
optionalParser ParserT e s m a
parser = Maybe a -> ParserT e s m (Maybe a) -> ParserT e s m (Maybe a)
forall (m :: * -> *) a e s.
Monad m =>
a -> ParserT e s m a -> ParserT e s m a
defaultParser Maybe a
forall a. Maybe a
Nothing ((a -> Maybe a) -> ParserT e s m a -> ParserT e s m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just ParserT e s m a
parser)

-- | Removes all failures from the parse results.
silenceParser :: Monad m => ParserT e s m a -> ParserT e s m a
silenceParser :: ParserT e s m a -> ParserT e s m a
silenceParser ParserT e s m a
parser = (s -> ListT m (ParseResult e s a)) -> ParserT e s m a
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
 -> ListT m (ParseResult e s a))
-> (s
    -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> s
-> ListT m (ParseResult e s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) e s a.
Monad m =>
ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go (ListT m (ParseResult e s a)
 -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a))))
-> (s -> ListT m (ParseResult e s a))
-> s
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e s m a -> s -> ListT m (ParseResult e s a)
forall e s (m :: * -> *) a.
ParserT e s m a -> s -> ListT m (ParseResult e s a)
runParserT ParserT e s m a
parser) where
  go :: ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ListT m (ParseResult e s a)
listt = do
    Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m <- ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
ListT.uncons ListT m (ParseResult e s a)
listt
    case Maybe (ParseResult e s a, ListT m (ParseResult e s a))
m of
      Maybe (ParseResult e s a, ListT m (ParseResult e s a))
Nothing -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. Maybe a
Nothing
      Just (r :: ParseResult e s a
r@(ParseResult ParseValue e a
v s
_), ListT m (ParseResult e s a)
rest) ->
        let nextListt :: m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt = ListT m (ParseResult e s a)
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
go ListT m (ParseResult e s a)
rest
        in case ParseValue e a
v of
          ParseError e
_ -> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt
          ParseSuccess a
_ -> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
-> m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParseResult e s a, ListT m (ParseResult e s a))
-> Maybe (ParseResult e s a, ListT m (ParseResult e s a))
forall a. a -> Maybe a
Just (ParseResult e s a
r, m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
-> ListT m (ParseResult e s a)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT m (Maybe (ParseResult e s a, ListT m (ParseResult e s a)))
nextListt))

-- | Yields the LONGEST string of 0 or more successes of the given parser (and passes through failures).
greedyStarParser :: Monad m => ParserT e s m a -> ParserT e s m [a]
greedyStarParser :: ParserT e s m a -> ParserT e s m [a]
greedyStarParser ParserT e s m a
parser = [a] -> ParserT e s m [a]
go [] where
  opt :: ParserT e s m (Maybe a)
opt = ParserT e s m a -> ParserT e s m (Maybe a)
forall (m :: * -> *) e s a.
Monad m =>
ParserT e s m a -> ParserT e s m (Maybe a)
optionalParser ParserT e s m a
parser
  go :: [a] -> ParserT e s m [a]
go ![a]
acc = do
    Maybe a
res <- ParserT e s m (Maybe a)
opt
    case Maybe a
res of
      Maybe a
Nothing -> [a] -> ParserT e s m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc)
      Just a
a -> [a] -> ParserT e s m [a]
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)

-- | Same as 'greedyStarParser' but discards the result.
greedyStarParser_ :: Monad m => ParserT e s m a -> ParserT e s m ()
greedyStarParser_ :: ParserT e s m a -> ParserT e s m ()
greedyStarParser_ ParserT e s m a
parser = ParserT e s m ()
go where
  opt :: ParserT e s m (Maybe a)
opt = ParserT e s m a -> ParserT e s m (Maybe a)
forall (m :: * -> *) e s a.
Monad m =>
ParserT e s m a -> ParserT e s m (Maybe a)
optionalParser ParserT e s m a
parser
  go :: ParserT e s m ()
go = do
    Maybe a
res <- ParserT e s m (Maybe a)
opt
    case Maybe a
res of
      Maybe a
Nothing -> () -> ParserT e s m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just a
_ -> ParserT e s m ()
go

-- | Yields the LONGEST string of 1 or more successes of the given parser (and passes through failures).
greedyPlusParser :: Monad m => ParserT e s m a -> ParserT e s m [a]
greedyPlusParser :: ParserT e s m a -> ParserT e s m [a]
greedyPlusParser ParserT e s m a
parser = (a -> [a] -> [a])
-> ParserT e s m a -> ParserT e s m [a] -> ParserT e s m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ParserT e s m a
parser (ParserT e s m a -> ParserT e s m [a]
forall (m :: * -> *) e s a.
Monad m =>
ParserT e s m a -> ParserT e s m [a]
greedyStarParser ParserT e s m a
parser)

-- | Same as 'greedyPlusParser' but discards the result.
greedyPlusParser_ :: Monad m => ParserT e s m a -> ParserT e s m ()
greedyPlusParser_ :: ParserT e s m a -> ParserT e s m ()
greedyPlusParser_ ParserT e s m a
parser = ParserT e s m a
parser ParserT e s m a -> ParserT e s m () -> ParserT e s m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e s m a -> ParserT e s m ()
forall (m :: * -> *) e s a.
Monad m =>
ParserT e s m a -> ParserT e s m ()
greedyStarParser_ ParserT e s m a
parser