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

import Control.Applicative (Alternative (..), liftA2)
import Control.Monad (MonadPlus (..), ap, (>=>))
import Control.Monad.Except (MonadError (..))
import Control.Monad.Identity (Identity (..))
import Control.Monad.Morph (MFunctor (..))
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))

instance MFunctor (ParserT e s) where
  hoist :: (forall a. m a -> n a) -> ParserT e s m b -> ParserT e s n b
hoist forall a. m a -> n a
trans (ParserT s -> ListT m (ParseResult e s b)
f) = (s -> ListT n (ParseResult e s b)) -> ParserT e s n b
forall e s (m :: * -> *) a.
(s -> ListT m (ParseResult e s a)) -> ParserT e s m a
ParserT ((forall a. m a -> n a)
-> ListT m (ParseResult e s b) -> ListT n (ParseResult e s b)
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
trans (ListT m (ParseResult e s b) -> ListT n (ParseResult e s b))
-> (s -> ListT m (ParseResult e s b))
-> s
-> ListT n (ParseResult e s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ListT m (ParseResult e s b)
f)

-- | 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.
-- Equvalent to 'asum'.
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))

gatherParser :: Monad m => Bool -> ParserT e s m a -> ParserT e s m a
gatherParser :: Bool -> ParserT e s m a -> ParserT e s m a
gatherParser Bool
single 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)))
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
_ ->
            let t :: ListT m (ParseResult e s a)
t = if Bool
single then ListT m (ParseResult e s a)
forall (f :: * -> *) a. Alternative f => f a
empty else 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)
            in 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, ListT m (ParseResult e s a)
t))

  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 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.
-- See 'isolateParser' if you want only one 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 = Bool -> ParserT e s m a -> ParserT e s m a
forall (m :: * -> *) e s a.
Monad m =>
Bool -> ParserT e s m a -> ParserT e s m a
gatherParser Bool
False

-- | If the parse results in ANY successes, keep only THE FIRST. Otherwise return all failures.
-- This may block indefinitely as it awaits either the end of the parser or its first success.
-- See 'suppressParser' if you want all successes.
isolateParser :: Monad m => ParserT e s m a -> ParserT e s m a
isolateParser :: ParserT e s m a -> ParserT e s m a
isolateParser = Bool -> ParserT e s m a -> ParserT e s m a
forall (m :: * -> *) e s a.
Monad m =>
Bool -> ParserT e s m a -> ParserT e s m a
gatherParser Bool
True

-- | 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.
-- Equivalent to 'catchError (const empty)'.
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

-- | Yield the results of the given parser, but rewind back to the starting state.
-- Note that these results may contain errors, so you may want to stifle them with 'silenceParser', for example.
lookAheadParser :: Monad m => ParserT e s m a -> ParserT e s m a
lookAheadParser :: ParserT e s m a -> ParserT e s m a
lookAheadParser ParserT e s m a
parser = do
  s
s <- ParserT e s m s
forall s (m :: * -> *). MonadState s m => m s
get
  (ParserT e s m a -> (e -> ParserT e s m a) -> ParserT e s m a)
-> (e -> ParserT e s m a) -> ParserT e s m a -> ParserT e s m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserT e s m a -> (e -> ParserT e s m a) -> ParserT e s m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (\e
e -> s -> ParserT e s m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s ParserT e s m () -> ParserT e s m a -> ParserT e s m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> e -> ParserT e s m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e) (ParserT e s m a -> ParserT e s m a)
-> ParserT e s m a -> ParserT e s m a
forall a b. (a -> b) -> a -> b
$ do
    a
v <- ParserT e s m a
parser
    s -> ParserT e s m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s
    a -> ParserT e s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v