{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
-- | A context-free memoizing parser that handles all alternatives in parallel
-- and carries a monadic computation with each parsing result.
module Text.Grampa.ContextFree.SortedMemoizing.Transformer (ParserT(Parser, applyParser), ResultListT(ResultList),
                                                            ResultsOfLengthT(ResultsOfLengthT, getResultsOfLength),
                                                            ResultsOfLength(ROL),
                                                            tbind, lift, tmap, longest, peg, terminalPEG)
where

import Control.Applicative
import Control.Monad (MonadPlus(..), join, void)
#if MIN_VERSION_base(4,13,0)
import Control.Monad (MonadFail(fail))
#endif
import qualified Control.Monad.Trans.Class as Trans (lift)
import Control.Monad.Trans.State.Strict (StateT, evalStateT)
import Data.Either (partitionEithers)
import Data.Function (on)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty((:|)), groupBy, nonEmpty, fromList, toList)
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid, splitPrimePrefix)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.Ord (Down(Down))
import Data.Semigroup (Semigroup((<>)))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)
import Witherable (Filterable(mapMaybe))
import Debug.Trace (trace)

import qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.Input.Position (fromEnd)
import Text.Parser.LookAhead (LookAheadParsing(..))

import qualified Rank2

import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
                          ConsumedInputParsing(..), CommittedParsing(..), DeterministicParsing(..),
                          AmbiguousParsing(..), Ambiguous(Ambiguous),
                          TailsParsing(..), ParseResults, ParseFailure(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected,
                             FallibleResults(..), AmbiguousAlternative(..), TraceableParsing(..))
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack

import Prelude hiding (iterate, null, showList, span, takeWhile)

-- | Parser for a context-free grammar with packrat-like sharing that carries a monadic computation as part of the
-- parse result.
newtype ParserT m g s r = Parser{forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser :: [(s, g (ResultListT m g s))] -> ResultListT m g s r}

newtype ResultsOfLengthT m g s r = ResultsOfLengthT{forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLengthT m g s r -> ResultsOfLength m g s (m r)
getResultsOfLength :: ResultsOfLength m g s (m r)}
data ResultsOfLength m g s a = ROL !Int ![(s, g (ResultListT m g s))] !(NonEmpty a)
data ResultListT m g s r = ResultList{forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> [ResultsOfLengthT m g s r]
resultSuccesses :: ![ResultsOfLengthT m g s r],
                                      forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> ParseFailure (Down Int) s
resultFailures  :: (ParseFailure Pos s)}

singleResult :: (Applicative m, Ord s) => Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult :: forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
len [(s, g (ResultListT m g s))]
rest r
a = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
len [(s, g (ResultListT m g s))]
rest (forall (f :: * -> *) a. Applicative f => a -> f a
pure r
aforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty

instance Functor m => Functor (ParserT m g s) where
   fmap :: forall a b. (a -> b) -> ParserT m g s a -> ParserT m g s b
fmap a -> b
f (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)
   {-# INLINE fmap #-}

instance (Applicative m, Ord s) => Applicative (ParserT m g s) where
   pure :: forall a. a -> ParserT m g s a
pure a
a = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
rest a
a)
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s (a -> b)
p <*> :: forall a b.
ParserT m g s (a -> b) -> ParserT m g s a -> ParserT m g s b
<*> Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s b
r where
      r :: [(s, g (ResultListT m g s))] -> ResultListT m g s b
r [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s (a -> b)
p [(s, g (ResultListT m g s))]
rest
               of ResultList [ResultsOfLengthT m g s (a -> b)]
results ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s (a -> b) -> ResultListT m g s b
continue [ResultsOfLengthT m g s (a -> b)]
results
      continue :: ResultsOfLengthT m g s (a -> b) -> ResultListT m g s b
continue (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
rest' NonEmpty (m (a -> b))
fs)) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {a} {r}.
Applicative m =>
Int -> ResultListT m g s a -> m (a -> r) -> ResultListT m g s r
continue' Int
l forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest') NonEmpty (m (a -> b))
fs
      continue' :: Int -> ResultListT m g s a -> m (a -> r) -> ResultListT m g s r
continue' Int
l (ResultList [ResultsOfLengthT m g s a]
rs ParseFailure (Down Int) s
failure) m (a -> r)
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall {m :: * -> *} {a} {r} {g :: (* -> *) -> *} {s}.
Applicative m =>
Int
-> m (a -> r)
-> ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s r
adjust Int
l m (a -> r)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs) ParseFailure (Down Int) s
failure
      adjust :: Int
-> m (a -> r)
-> ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s r
adjust Int
l m (a -> r)
f (ResultsOfLengthT (ROL Int
l' [(s, g (ResultListT m g s))]
rest' NonEmpty (m a)
as)) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
lforall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultListT m g s))]
rest' ((m (a -> r)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m a)
as))
   {-# INLINABLE pure #-}
   {-# INLINABLE (<*>) #-}

instance (Applicative m, Ord s) => Alternative (ParserT m g s) where
   empty :: forall a. ParserT m g s a
empty = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <|> :: forall a. ParserT m g s a -> ParserT m g s a -> ParserT m g s a
<|> Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
r where
      r :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
r [(s, g (ResultListT m g s))]
rest = [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest
   {-# INLINE (<|>) #-}
   {-# INLINABLE empty #-}

instance (Applicative m, Traversable m) => Filterable (ParserT m g s) where
  mapMaybe :: forall a b. (a -> Maybe b) -> ParserT m g s a -> ParserT m g s b
mapMaybe a -> Maybe b
f (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)

-- | The 'StateT' instance dangerously assumes that the filtered parser is stateless.
instance {-# overlaps #-} (Monad m, Traversable m, Monoid state) => Filterable (ParserT (StateT state m) g s) where
  mapMaybe :: forall a b.
(a -> Maybe b)
-> ParserT (StateT state m) g s a -> ParserT (StateT state m) g s b
mapMaybe a -> Maybe b
f (Parser [(s, g (ResultListT (StateT state m) g s))]
-> ResultListT (StateT state m) g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT (StateT state m) g s))]
-> ResultListT (StateT state m) g s a
p)

instance (Monad m, Traversable m, Ord s) => Monad (ParserT m g s) where
   return :: forall a. a -> ParserT m g s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   >> :: forall a b. ParserT m g s a -> ParserT m g s b -> ParserT m g s b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p >>= :: forall a b.
ParserT m g s a -> (a -> ParserT m g s b) -> ParserT m g s b
>>= a -> ParserT m g s b
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s b
q where
      q :: [(s, g (ResultListT m g s))] -> ResultListT m g s b
q [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
               of ResultList [ResultsOfLengthT m g s a]
results ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s a -> ResultListT m g s b
continue [ResultsOfLengthT m g s a]
results
      continue :: ResultsOfLengthT m g s a -> ResultListT m g s b
continue (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
rest' NonEmpty (m a)
rs)) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {r}.
Int -> ResultListT m g s r -> ResultListT m g s r
continue' Int
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser [(s, g (ResultListT m g s))]
rest' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m (ParserT m g s a) -> ParserT m g s a
rejoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ParserT m g s b
f) NonEmpty (m a)
rs
      continue' :: Int -> ResultListT m g s r -> ResultListT m g s r
continue' Int
l (ResultList [ResultsOfLengthT m g s r]
rs ParseFailure (Down Int) s
failure) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {r}.
Int -> ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r
adjust Int
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s r]
rs) ParseFailure (Down Int) s
failure
      adjust :: Int -> ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r
adjust Int
l (ResultsOfLengthT (ROL Int
l' [(s, g (ResultListT m g s))]
rest' NonEmpty (m r)
rs)) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
lforall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultListT m g s))]
rest' NonEmpty (m r)
rs)
      rejoin :: forall a. m (ParserT m g s a) -> ParserT m g s a
      rejoinResults :: forall a. m (ResultListT m g s a) -> ResultListT m g s a
      rejoinResultsOfLengthT :: forall a. m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
      rejoin :: forall a. m (ParserT m g s a) -> ParserT m g s a
rejoin m (ParserT m g s a)
m = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> forall a. m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser [(s, g (ResultListT m g s))]
rest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ParserT m g s a)
m)
      rejoinResults :: forall a. m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults m (ResultListT m g s a)
m = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
rejoinResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> [ResultsOfLengthT m g s r]
resultSuccesses forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ResultListT m g s a)
m) (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> ParseFailure (Down Int) s
resultFailures m (ResultListT m g s a)
m)
      rejoinResultsOfLengthT :: forall a. m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
rejoinResultsOfLengthT m (ResultsOfLengthT m g s a)
m = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLengthT m g s r -> ResultsOfLength m g s (m r)
getResultsOfLength m (ResultsOfLengthT m g s a)
m)

#if MIN_VERSION_base(4,13,0)
instance (Monad m, Traversable m, Ord s) => MonadFail (ParserT m g s) where
#endif
   fail :: forall a. String -> ParserT m g s a
fail String
msg = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
msg)

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

-- | Lift a parse-free computation into the parser.
lift :: Ord s => m a -> ParserT m g s a
lift :: forall s (m :: * -> *) a (g :: (* -> *) -> *).
Ord s =>
m a -> ParserT m g s a
lift m a
m = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 [(s, g (ResultListT m g s))]
rest (m a
mforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty)

-- | Transform the computation carried by the parser using the monadic bind ('>>=').
tbind :: Monad m => ParserT m g s a -> (a -> m b) -> ParserT m g s b
tbind :: forall (m :: * -> *) (g :: (* -> *) -> *) s a b.
Monad m =>
ParserT m g s a -> (a -> m b) -> ParserT m g s b
tbind (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) a -> m b
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
Monad m =>
(a -> m b) -> ResultListT m g s a -> ResultListT m g s b
bindResultList a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)

-- | Transform the computation carried by the parser.
tmap :: (m a -> m b) -> ParserT m g s a -> ParserT m g s b
tmap :: forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b) -> ParserT m g s a -> ParserT m g s b
tmap m a -> m b
f (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList m a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)

bindResultList :: Monad m => (a -> m b) -> ResultListT m g s a -> ResultListT m g s b
bindResultList :: forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
Monad m =>
(a -> m b) -> ResultListT m g s a -> ResultListT m g s b
bindResultList a -> m b
f (ResultList [ResultsOfLengthT m g s a]
successes ParseFailure (Down Int) s
failures) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
Monad m =>
(a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
bindResults a -> m b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
successes) ParseFailure (Down Int) s
failures

mapResultList :: (m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList :: forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList m a -> m b
f (ResultList [ResultsOfLengthT m g s a]
successes ParseFailure (Down Int) s
failures) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
mapResults m a -> m b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
successes) ParseFailure (Down Int) s
failures

bindResults :: Monad m => (a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
bindResults :: forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
Monad m =>
(a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
bindResults a -> m b
f (ResultsOfLengthT (ROL Int
len [(s, g (ResultListT m g s))]
rest NonEmpty (m a)
as)) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
len [(s, g (ResultListT m g s))]
rest ((forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m a)
as))

mapResults :: (m a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
mapResults :: forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
mapResults m a -> m b
f (ResultsOfLengthT ResultsOfLength m g s (m a)
rol) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (m a -> m b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultsOfLength m g s (m a)
rol)

instance (Applicative m, Semigroup x, Ord s) => Semigroup (ParserT m g s x) where
   <> :: ParserT m g s x -> ParserT m g s x -> ParserT m g s x
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Applicative m, Monoid x, Ord s) => Monoid (ParserT m g s x) where
   mempty :: ParserT m g s x
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
   mappend :: ParserT m g s x -> ParserT m g s x -> ParserT m g s x
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Memoizing parser that carries an applicative computation. Can be wrapped with
-- 'Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive.Fixed' to provide left recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (Applicative m, LeftReductive s, FactorialMonoid s, Ord s) => MultiParsing (ParserT m g s) where
   type GrammarConstraint (ParserT m g s) g' = (g ~ g', Rank2.Functor g)
   type ResultFunctor (ParserT m g s) = Compose (Compose (ParseResults s) []) m
   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
   parsePrefix :: forall s (g :: (* -> *) -> *).
(ParserInput (ParserT m g s) ~ s,
 GrammarConstraint (ParserT m g s) g, Eq s, FactorialMonoid s) =>
g (ParserT m g s)
-> s -> g (Compose (ResultFunctor (ParserT m g s)) ((,) s))
parsePrefix g (ParserT m g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList)
                                    (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s (m :: * -> *).
(Functor g, FactorialMonoid s) =>
g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails g (ParserT m g s)
g s
input)
   -- parseComplete :: (ParserInput (ParserT m g s) ~ s, Rank2.Functor g, Eq s, FactorialMonoid s) =>
   --                  g (ParserT m g s) -> s -> g (Compose (Compose (ParseResults s) []) m)
   parseComplete :: forall s (g :: (* -> *) -> *).
(ParserInput (ParserT m g s) ~ s,
 GrammarConstraint (ParserT m g s) g, Eq s, FactorialMonoid s) =>
g (ParserT m g s) -> s -> g (ResultFunctor (ParserT m g s))
parseComplete g (ParserT m g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList)
                              (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(TailsParsing m, GrammarConstraint m g, Functor g) =>
g m
-> [(ParserInput m, g (GrammarFunctor m))]
-> [(ParserInput m, g (GrammarFunctor m))]
parseAllTails g (ParserT m g s)
close forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s (m :: * -> *).
(Functor g, FactorialMonoid s) =>
g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails g (ParserT m g s)
g s
input)
      where close :: g (ParserT m g s)
close = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
eof) g (ParserT m g s)
g

-- | Memoizing parser that carries an applicative computation. Can be wrapped with
-- 'Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive.Fixed' to provide left recursion support.
instance (Applicative m, Ord s, LeftReductive s, FactorialMonoid s) => GrammarParsing (ParserT m g s) where
   type ParserGrammar (ParserT m g s) = g
   type GrammarFunctor (ParserT m g s) = ResultListT m g s
   parsingResult :: forall a.
ParserInput (ParserT m g s)
-> GrammarFunctor (ParserT m g s) a
-> ResultFunctor (ParserT m g s) (ParserInput (ParserT m g s), a)
parsingResult ParserInput (ParserT m g s)
_ = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList
   nonTerminal :: (ParserInput (ParserT m g s) ~ s) => (g (ResultListT m g s) -> ResultListT m g s a) -> ParserT m g s a
   nonTerminal :: forall a.
(ParserInput (ParserT m g s) ~ s) =>
(g (ResultListT m g s) -> ResultListT m g s a) -> ParserT m g s a
nonTerminal g (ResultListT m g s) -> ResultListT m g s a
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p where
      p :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
p input :: [(s, g (ResultListT m g s))]
input@((s
_, g (ResultListT m g s)
d) : [(s, g (ResultListT m g s))]
_) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
rs' ParseFailure (Down Int) s
failure
         where ResultList [ResultsOfLengthT m g s a]
rs ParseFailure (Down Int) s
failure = g (ResultListT m g s) -> ResultListT m g s a
f g (ResultListT m g s)
d
               rs' :: [ResultsOfLengthT m g s a]
rs' = ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a
sync forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs
               -- in left-recursive grammars the stored input remainder may be wrong, so revert to the complete input
               sync :: ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a
sync (ResultsOfLengthT (ROL Int
0 [(s, g (ResultListT m g s))]
_remainder NonEmpty (m a)
r)) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 [(s, g (ResultListT m g s))]
input NonEmpty (m a)
r)
               sync ResultsOfLengthT m g s a
rols = ResultsOfLengthT m g s a
rols
      p [(s, g (ResultListT m g s))]
_ = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"NonTerminal at endOfInput")
   {-# INLINE nonTerminal #-}
   chainRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (ParserT m g s),
 f ~ GrammarFunctor (ParserT m g s),
 GrammarConstraint (ParserT m g s) g) =>
(f a -> g f -> g f)
-> ParserT m g s a -> ParserT m g s a -> ParserT m g s a
chainRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
base) (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
recurse) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g f)] -> ResultListT m g s a
q
      where q :: [(s, g f)] -> ResultListT m g s a
q [] = [(s, g (ResultListT m g s))] -> ResultListT m g s a
base []
            q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                           of r :: ResultListT m g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultListT m g s a
r
                              ResultListT m g s a
r -> ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
iter ResultListT m g s a
r ResultListT m g s a
r
               where iter :: ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
iter f a
marginal ResultListT m g s a
total = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
recurse ((s
s, f a -> g f -> g f
assign f a
marginal g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                                           of ResultList [] ParseFailure (Down Int) s
_ -> ResultListT m g s a
total
                                              ResultListT m g s a
r -> ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
iter ResultListT m g s a
r (ResultListT m g s a
total forall a. Semigroup a => a -> a -> a
<> ResultListT m g s a
r)
   chainLongestRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (ParserT m g s),
 f ~ GrammarFunctor (ParserT m g s),
 GrammarConstraint (ParserT m g s) g) =>
(f a -> g f -> g f)
-> ParserT m g s a -> ParserT m g s a -> ParserT m g s a
chainLongestRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
base) (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
recurse) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g f)] -> ResultListT m g s a
q
      where q :: [(s, g f)] -> ResultListT m g s a
q [] = [(s, g (ResultListT m g s))] -> ResultListT m g s a
base []
            q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                           of r :: ResultListT m g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultListT m g s a
r
                              ResultListT m g s a
r -> ResultListT m g s a -> f a
iter ResultListT m g s a
r
               where iter :: ResultListT m g s a -> f a
iter f a
r = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
recurse ((s
s, f a -> g f -> g f
assign f a
r g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                              of ResultList [] ParseFailure (Down Int) s
_ -> f a
r
                                 ResultListT m g s a
r' -> ResultListT m g s a -> f a
iter ResultListT m g s a
r'

instance (Applicative m, Ord s, LeftReductive s, FactorialMonoid s, Rank2.Functor g) =>
         TailsParsing (ParserT m g s) where
   parseTails :: forall (g :: (* -> *) -> *) r.
GrammarConstraint (ParserT m g s) g =>
ParserT m g s r
-> [(ParserInput (ParserT m g s),
     g (GrammarFunctor (ParserT m g s)))]
-> GrammarFunctor (ParserT m g s) r
parseTails = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser

parseGrammarTails :: (Rank2.Functor g, FactorialMonoid s) => g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails :: forall (g :: (* -> *) -> *) s (m :: * -> *).
(Functor g, FactorialMonoid s) =>
g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails g (ParserT m g s)
g s
input = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
parseTail [] (forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
   where parseTail :: s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
parseTail s
s [(s, g (ResultListT m g s))]
parsedTail = [(s, g (ResultListT m g s))]
parsed
            where parsed :: [(s, g (ResultListT m g s))]
parsed = (s
s,g (ResultListT m g s)
d)forall a. a -> [a] -> [a]
:[(s, g (ResultListT m g s))]
parsedTail
                  d :: g (ResultListT m g s)
d      = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))]
parsed) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser) g (ParserT m g s)
g

instance (Applicative m, LeftReductive s, FactorialMonoid s, Ord s) => InputParsing (ParserT m g s) where
   type ParserInput (ParserT m g s) = s
   getInput :: ParserT m g s (ParserInput (ParserT m g s))
getInput = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser forall {m :: * -> *} {r} {g :: (* -> *) -> *}.
(Applicative m, Ord r, Monoid r) =>
[(r, g (ResultListT m g r))] -> ResultListT m g r r
p
      where p :: [(r, g (ResultListT m g r))] -> ResultListT m g r r
p rest :: [(r, g (ResultListT m g r))]
rest@((r
s, g (ResultListT m g r)
_):[(r, g (ResultListT m g r))]
_) = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(r, g (ResultListT m g r))]
rest r
s
            p [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] forall a. Monoid a => a
mempty
   anyToken :: ParserT m g s (ParserInput (ParserT m g s))
anyToken = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser forall {r} {m :: * -> *} {g :: (* -> *) -> *}.
(FactorialMonoid r, Applicative m, Ord r) =>
[(r, g (ResultListT m g r))] -> ResultListT m g r r
p
      where p :: [(r, g (ResultListT m g r))] -> ResultListT m g r r
p rest :: [(r, g (ResultListT m g r))]
rest@((r
s, g (ResultListT m g r)
_):[(r, g (ResultListT m g r))]
t) = case forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
                                of Just (r
first, r
_) -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
1 [(r, g (ResultListT m g r))]
t r
first
                                   Maybe (r, r)
_ -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(r, g (ResultListT m g r))]
rest) String
"anyToken")
            p [] = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"anyToken")
   satisfy :: (ParserInput (ParserT m g s) -> Bool)
-> ParserT m g s (ParserInput (ParserT m g s))
satisfy ParserInput (ParserT m g s) -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
t) =
               case forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
               of Just (s
first, s
_) | ParserInput (ParserT m g s) -> Bool
predicate s
first -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
1 [(s, g (ResultListT m g s))]
t s
first
                  Maybe (s, s)
_ -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"satisfy")
            p [] = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfy")
   scan :: forall state.
state
-> (state -> ParserInput (ParserT m g s) -> Maybe state)
-> ParserT m g s (ParserInput (ParserT m g s))
scan state
s0 state -> ParserInput (ParserT m g s) -> Maybe state
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (state -> [(s, g (ResultListT m g s))] -> ResultListT m g s s
p state
s0)
      where p :: state -> [(s, g (ResultListT m g s))] -> ResultListT m g s s
p state
s rest :: [(s, g (ResultListT m g s))]
rest@((s
i, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_) = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
prefix
               where (s
prefix, s
_, state
_) = forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> ParserInput (ParserT m g s) -> Maybe state
f s
i
                     l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] forall a. Monoid a => a
mempty
   takeWhile :: (ParserInput (ParserT m g s) -> Bool)
-> ParserT m g s (ParserInput (ParserT m g s))
takeWhile ParserInput (ParserT m g s) -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
               | s
x <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (ParserT m g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
                    forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
            p [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] forall a. Monoid a => a
mempty
   take :: Int -> ParserT m g s (ParserInput (ParserT m g s))
take Int
0 = forall a. Monoid a => a
mempty
   take Int
n = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
               | s
x <- forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Eq a => a -> a -> Bool
== Int
n =
                    forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
            p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
   takeWhile1 :: (ParserInput (ParserT m g s) -> Bool)
-> ParserT m g s (ParserInput (ParserT m g s))
takeWhile1 ParserInput (ParserT m g s) -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
               | s
x <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (ParserT m g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
                    forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
            p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"takeWhile1")
   string :: ParserInput (ParserT m g s)
-> ParserT m g s (ParserInput (ParserT m g s))
string ParserInput (ParserT m g s)
s = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p where
      p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s', g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
         | ParserInput (ParserT m g s)
s forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) ParserInput (ParserT m g s)
s
      p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> s -> ParseFailure (Down Int) s
expectedInput (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) ParserInput (ParserT m g s)
s)
      l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length ParserInput (ParserT m g s)
s
   notSatisfy :: (ParserInput (ParserT m g s) -> Bool) -> ParserT m g s ()
notSatisfy ParserInput (ParserT m g s) -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s ()
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s ()
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_)
               | Just (s
first, s
_) <- forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 ParserInput (ParserT m g s) -> Bool
predicate s
first = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"notSatisfy")
            p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
rest ()
   {-# INLINABLE string #-}

instance (InputParsing (ParserT m g s), FactorialMonoid s) => TraceableParsing (ParserT m g s) where
   traceInput :: forall a.
(ParserInput (ParserT m g s) -> String)
-> ParserT m g s a -> ParserT m g s a
traceInput ParserInput (ParserT m g s) -> String
description (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_) = case forall a. String -> a -> a
trace (String
"Parsing " forall a. Semigroup a => a -> a -> a
<> ParserInput (ParserT m g s) -> String
description s
s) ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest) of
               rl :: ResultListT m g s a
rl@(ResultList [] ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Failed " forall a. Semigroup a => a -> a -> a
<> (s -> s) -> String
descriptionWith forall a. a -> a
id) ResultListT m g s a
rl
               rl :: ResultListT m g s a
rl@(ResultList [ResultsOfLengthT m g s a]
rs ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Parsed [" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ResultsOfLengthT m g s a -> String
describeResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs) forall a. Semigroup a => a -> a -> a
<> String
"]") ResultListT m g s a
rl
               where describeResult :: ResultsOfLengthT m g s a -> String
describeResult (ResultsOfLengthT (ROL Int
len [(s, g (ResultListT m g s))]
_ NonEmpty (m a)
_)) = (s -> s) -> String
descriptionWith (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
len)
                     descriptionWith :: (s -> s) -> String
descriptionWith s -> s
f = ParserInput (ParserT m g s) -> String
description (s -> s
f s
s)
            q [] = [(s, g (ResultListT m g s))] -> ResultListT m g s a
p []

instance (Applicative m, Ord s, Show s, TextualMonoid s) => InputCharParsing (ParserT m g s) where
   satisfyCharInput :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
satisfyCharInput Char -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
t) =
               case forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first
                     | Char -> Bool
predicate Char
first -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
1 [(s, g (ResultListT m g s))]
t (forall m. Factorial m => m -> m
Factorial.primePrefix s
s)
                  Maybe Char
_ -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"satisfyCharInput")
            p [] = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfyCharInput")
   scanChars :: forall state.
state
-> (state -> Char -> Maybe state)
-> ParserT m g s (ParserInput (ParserT m g s))
scanChars state
s0 state -> Char -> Maybe state
f = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (state -> [(s, g (ResultListT m g s))] -> ResultListT m g s s
p state
s0)
      where p :: state -> [(s, g (ResultListT m g s))] -> ResultListT m g s s
p state
s rest :: [(s, g (ResultListT m g s))]
rest@((s
i, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_) = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
prefix
               where (s
prefix, s
_, state
_) = forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
                     l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile Char -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
               | s
x <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
                    forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
            p [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile1 Char -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s s
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s s
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_)
               | s
x <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
                    forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
            p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"takeCharsWhile1")
   notSatisfyChar :: (Char -> Bool) -> ParserT m g s ()
notSatisfyChar Char -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s ()
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s ()
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_)
               | Just Char
first <- forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"notSatisfyChar")
            p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
rest ()

instance (Applicative m, LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (ParserT m g s) where
   match :: forall a.
ParserT m g s a -> ParserT m g s (ParserInput (ParserT m g s), a)
match (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s (s, a)
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s (s, a)
q [] = forall {m :: * -> *} {a} {g :: (* -> *) -> *} {s} {a}.
(Functor m, FactorialMonoid a) =>
a -> ResultListT m g s a -> ResultListT m g s (a, a)
addConsumed forall a. Monoid a => a
mempty ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [])
            q rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_) : [(s, g (ResultListT m g s))]
_) = forall {m :: * -> *} {a} {g :: (* -> *) -> *} {s} {a}.
(Functor m, FactorialMonoid a) =>
a -> ResultListT m g s a -> ResultListT m g s (a, a)
addConsumed s
s ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
            addConsumed :: a -> ResultListT m g s a -> ResultListT m g s (a, a)
addConsumed a
input (ResultList [ResultsOfLengthT m g s a]
rl ParseFailure (Down Int) s
failure) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s (a, a)
add1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rl) ParseFailure (Down Int) s
failure
               where add1 :: ResultsOfLengthT m g s a -> ResultsOfLengthT m g s (a, a)
add1 (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
t NonEmpty (m a)
rs)) =
                        forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l [(s, g (ResultListT m g s))]
t forall a b. (a -> b) -> a -> b
$ ((,) (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
l a
input) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m a)
rs)

instance (Applicative m, MonoidNull s, Ord s) => Parsing (ParserT m g s) where
   try :: forall a. ParserT m g s a -> ParserT m g s a
try (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = ResultListT m g s a -> ResultListT m g s a
rewindFailure ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
               where rewindFailure :: ResultListT m g s a -> ResultListT m g s a
rewindFailure (ResultList [ResultsOfLengthT m g s a]
rl ParseFailure (Down Int) s
_) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
rl (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest)
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <?> :: forall a. ParserT m g s a -> String -> ParserT m g s a
<?> String
msg  = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = ResultListT m g s a -> ResultListT m g s a
replaceFailure ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
               where replaceFailure :: ResultListT m g s a -> ResultListT m g s a
replaceFailure (ResultList [] ParseFailure (Down Int) s
f) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [] (forall s.
Down Int
-> String -> ParseFailure (Down Int) s -> ParseFailure (Down Int) s
replaceExpected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
msg ParseFailure (Down Int) s
f)
                     replaceFailure ResultListT m g s a
rl = ResultListT m g s a
rl
   notFollowedBy :: forall a. Show a => ParserT m g s a -> ParserT m g s ()
notFollowedBy (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
input-> forall {m :: * -> *} {s} {g :: (* -> *) -> *} {m :: * -> *}
       {g :: (* -> *) -> *} {s} {r}.
(Applicative m, Ord s) =>
[(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s ()
rewind [(s, g (ResultListT m g s))]
input ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
input))
      where rewind :: [(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s ()
rewind [(s, g (ResultListT m g s))]
t (ResultList [] ParseFailure (Down Int) s
_) = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
t ()
            rewind [(s, g (ResultListT m g s))]
t ResultList{} = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
t) String
"notFollowedBy")
   skipMany :: forall a. ParserT m g s a -> ParserT m g s ()
skipMany ParserT m g s a
p = ParserT m g s ()
go
      where go :: ParserT m g s ()
go = forall (f :: * -> *) a. Applicative f => a -> f a
pure () forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try ParserT m g s a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT m g s ()
go
   unexpected :: forall a. String -> ParserT m g s a
unexpected String
msg = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
t-> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
t) String
msg)
   eof :: ParserT m g s ()
eof = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser forall {s} {m :: * -> *} {g :: (* -> *) -> *}.
(MonoidNull s, Applicative m, Ord s) =>
[(s, g (ResultListT m g s))] -> ResultListT m g s ()
f
      where f :: [(s, g (ResultListT m g s))] -> ResultListT m g s ()
f rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_)
               | forall m. MonoidNull m => m -> Bool
null s
s = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
rest ()
               | Bool
otherwise = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"end of input")
            f [] = forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [] ()

instance (Applicative m, MonoidNull s, Ord s) => DeterministicParsing (ParserT m g s) where
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <<|> :: forall a. ParserT m g s a -> ParserT m g s a -> ParserT m g s a
<<|> Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
r where
      r :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
r [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
               of rl :: ResultListT m g s a
rl@(ResultList [] ParseFailure (Down Int) s
_failure) -> ResultListT m g s a
rl forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest
                  ResultListT m g s a
rl -> ResultListT m g s a
rl
   takeSome :: forall a. ParserT m g s a -> ParserT m g s [a]
takeSome ParserT m g s a
p = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT m g s a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany ParserT m g s a
p
   takeMany :: forall a. ParserT m g s a -> ParserT m g s [a]
takeMany (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (Int
-> m ([a] -> [a])
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s [a]
q Int
0 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id)) where
      q :: Int
-> m ([a] -> [a])
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s [a]
q !Int
len m ([a] -> [a])
acc [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
                        of ResultList [] ParseFailure (Down Int) s
_failure
                              -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
len [(s, g (ResultListT m g s))]
rest (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ []) m ([a] -> [a])
acc forall a. a -> [a] -> NonEmpty a
:| [])] forall a. Monoid a => a
mempty
                           ResultList [ResultsOfLengthT m g s a]
rl ParseFailure (Down Int) s
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s a -> ResultListT m g s [a]
continue [ResultsOfLengthT m g s a]
rl
         where continue :: ResultsOfLengthT m g s a -> ResultListT m g s [a]
continue (ResultsOfLengthT (ROL Int
len' [(s, g (ResultListT m g s))]
rest' NonEmpty (m a)
results)) =
                  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\m a
r-> Int
-> m ([a] -> [a])
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s [a]
q (Int
len forall a. Num a => a -> a -> a
+ Int
len') (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) m ([a] -> [a])
acc ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
r)) [(s, g (ResultListT m g s))]
rest') NonEmpty (m a)
results
   skipAll :: forall a. ParserT m g s a -> ParserT m g s ()
skipAll (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (Int -> m () -> [(s, g (ResultListT m g s))] -> ResultListT m g s ()
q Int
0 (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) where
      q :: Int -> m () -> [(s, g (ResultListT m g s))] -> ResultListT m g s ()
q !Int
len m ()
effects [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
                       of ResultList [] ParseFailure (Down Int) s
_failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
len [(s, g (ResultListT m g s))]
rest (m ()
effectsforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                          ResultList [ResultsOfLengthT m g s a]
rl ParseFailure (Down Int) s
_failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s a -> ResultListT m g s ()
continue [ResultsOfLengthT m g s a]
rl
         where continue :: ResultsOfLengthT m g s a -> ResultListT m g s ()
continue (ResultsOfLengthT (ROL Int
len' [(s, g (ResultListT m g s))]
rest' NonEmpty (m a)
results)) =
                  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\m a
r-> Int -> m () -> [(s, g (ResultListT m g s))] -> ResultListT m g s ()
q (Int
len forall a. Num a => a -> a -> a
+ Int
len') (m ()
effects forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m a
r) [(s, g (ResultListT m g s))]
rest') NonEmpty (m a)
results

instance (Applicative m, Traversable m, Ord s) => CommittedParsing (ParserT m g s) where
   type CommittedResults (ParserT m g s) = ParseResults s
   commit :: forall a.
ParserT m g s a
-> ParserT m g s (CommittedResults (ParserT m g s) a)
commit (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))]
-> ResultListT m g s (Either (ParseFailure (Down Int) s) a)
q
      where q :: [(s, g (ResultListT m g s))]
-> ResultListT m g s (Either (ParseFailure (Down Int) s) a)
q [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
                     of ResultList [] ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT
                                                             forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 [(s, g (ResultListT m g s))]
rest (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure) forall a. a -> [a] -> NonEmpty a
:| [])] forall a. Monoid a => a
mempty
                        ResultList [ResultsOfLengthT m g s a]
rl ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
mapResults (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rl) ParseFailure (Down Int) s
failure
   admit :: forall a.
ParserT m g s (CommittedResults (ParserT m g s) a)
-> ParserT m g s a
admit (Parser [(s, g (ResultListT m g s))]
-> ResultListT m g s (CommittedResults (ParserT m g s) a)
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))]
-> ResultListT m g s (CommittedResults (ParserT m g s) a)
p [(s, g (ResultListT m g s))]
rest
                     of ResultList [] ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [] ParseFailure (Down Int) s
failure
                        ResultList [ResultsOfLengthT m g s (CommittedResults (ParserT m g s) a)]
rl ParseFailure (Down Int) s
failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {m :: * -> *} {s} {g :: (* -> *) -> *} {r}.
(Traversable m, Ord s) =>
ResultsOfLengthT m g s (Either (ParseFailure (Down Int) s) r)
-> ResultListT m g s r
expose [ResultsOfLengthT m g s (CommittedResults (ParserT m g s) a)]
rl forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [] ParseFailure (Down Int) s
failure
            expose :: ResultsOfLengthT m g s (Either (ParseFailure (Down Int) s) r)
-> ResultListT m g s r
expose (ResultsOfLengthT (ROL Int
len [(s, g (ResultListT m g s))]
t NonEmpty (m (Either (ParseFailure (Down Int) s) r))
rs)) = case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [m r]
successes of
               Maybe (NonEmpty (m r))
Nothing -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
               Just NonEmpty (m r)
successes' -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
len [(s, g (ResultListT m g s))]
t NonEmpty (m r)
successes'] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
               where ([ParseFailure (Down Int) s]
failures, [m r]
successes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty (m (Either (ParseFailure (Down Int) s) r))
rs)

instance (Applicative m, MonoidNull s, Ord s) => LookAheadParsing (ParserT m g s) where
   lookAhead :: forall a. ParserT m g s a -> ParserT m g s a
lookAhead (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
input-> forall {s} {g :: (* -> *) -> *} {m :: * -> *} {r}.
[(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s r
rewind [(s, g (ResultListT m g s))]
input ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
input))
      where rewind :: [(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s r
rewind [(s, g (ResultListT m g s))]
_ rl :: ResultListT m g s r
rl@(ResultList [] ParseFailure (Down Int) s
_) = ResultListT m g s r
rl
            rewind [(s, g (ResultListT m g s))]
t (ResultList [ResultsOfLengthT m g s r]
rl ParseFailure (Down Int) s
failure) =
               forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 [(s, g (ResultListT m g s))]
t forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Semigroup a => a -> a -> a
(<>) (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {r}.
ResultsOfLengthT m g s r -> NonEmpty (m r)
results forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s r]
rl)] ParseFailure (Down Int) s
failure
            results :: ResultsOfLengthT m g s r -> NonEmpty (m r)
results (ResultsOfLengthT (ROL Int
_ [(s, g (ResultListT m g s))]
_ NonEmpty (m r)
r)) = NonEmpty (m r)
r

instance (Applicative m, Ord s, Show s, TextualMonoid s) => CharParsing (ParserT m g s) where
   satisfy :: (Char -> Bool) -> ParserT m g s Char
satisfy Char -> Bool
predicate = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s Char
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s Char
p rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
t) =
               case forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
1 [(s, g (ResultListT m g s))]
t Char
first
                  Maybe Char
_ -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"Char.satisfy")
            p [] = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"Char.satisfy")
   string :: String -> ParserT m g s String
string String
s = forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> ParserT m g s Text
text Text
t = (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance (Applicative m, Eq (m ()), Ord s) => AmbiguousParsing (ParserT m g s) where
   ambiguous :: forall a. ParserT m g s a -> ParserT m g s (Ambiguous a)
ambiguous (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s (Ambiguous a)
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s (Ambiguous a)
q [(s, g (ResultListT m g s))]
rest | ResultList [ResultsOfLengthT m g s a]
rs ParseFailure (Down Int) s
failure <- [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall r.
ResultsOfLengthT m g s r -> ResultsOfLengthT m g s (Ambiguous r)
groupByLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs) ParseFailure (Down Int) s
failure
            groupByLength :: ResultsOfLengthT m g s r -> ResultsOfLengthT m g s (Ambiguous r)
            groupByLength :: forall r.
ResultsOfLengthT m g s r -> ResultsOfLengthT m g s (Ambiguous r)
groupByLength (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
rest NonEmpty (m r)
rs)) =
               forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l [(s, g (ResultListT m g s))]
rest forall a b. (a -> b) -> a -> b
$ (forall a. NonEmpty a -> Ambiguous a
Ambiguous forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
fromList (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a. Functor f => f a -> f ()
void) NonEmpty (m r)
rs))

-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
-- of input tails, opposite of 'peg'
longest :: ParserT Identity g s a -> Backtrack.Parser g [(s, g (ResultListT Identity g s))] a
longest :: forall (g :: (* -> *) -> *) s a.
ParserT Identity g s a
-> Parser g [(s, g (ResultListT Identity g s))] a
longest ParserT Identity g s a
p = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
q where
   q :: [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
q [(s, g (ResultListT Identity g s))]
rest = case forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser ParserT Identity g s a
p [(s, g (ResultListT Identity g s))]
rest
            of ResultList [] (ParseFailure Down Int
pos (FailureDescription [String]
expected [s]
inputs) [String]
errors)
                  -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
Backtrack.NoParse (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. a -> [(a, b)]
wrap [s]
inputs) [String]
errors)
               ResultList [ResultsOfLengthT Identity g s a]
rs ParseFailure (Down Int) s
_ -> forall {g :: (* -> *) -> *} {s} {v} {g :: (* -> *) -> *}.
ResultsOfLengthT Identity g s v
-> Result g [(s, g (ResultListT Identity g s))] v
parsed (forall a. [a] -> a
last [ResultsOfLengthT Identity g s a]
rs)
   parsed :: ResultsOfLengthT Identity g s v
-> Result g [(s, g (ResultListT Identity g s))] v
parsed (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT Identity g s))]
s (Identity v
r:|[Identity v]
_))) = forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultListT Identity g s))]
s
   wrap :: a -> [(a, b)]
wrap a
s = [(a
s, forall a. HasCallStack => String -> a
error String
"longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
peg :: (Applicative m, Ord s) => Backtrack.Parser g [(s, g (ResultListT m g s))] a -> ParserT m g s a
peg :: forall (m :: * -> *) s (g :: (* -> *) -> *) a.
(Applicative m, Ord s) =>
Parser g [(s, g (ResultListT m g s))] a -> ParserT m g s a
peg Parser g [(s, g (ResultListT m g s))] a
p = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q where
   q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultListT m g s))] a
p [(s, g (ResultListT m g s))]
rest
            of Backtrack.Parsed Int
l a
result [(s, g (ResultListT m g s))]
suffix -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l [(s, g (ResultListT m g s))]
suffix a
result
               Backtrack.NoParse (ParseFailure Down Int
pos (FailureDescription [String]
expected [[(s, g (ResultListT m g s))]]
inputs) [String]
errors)
                  -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(s, g (ResultListT m g s))]]
inputs)) [String]
errors)

-- | Turns a backtracking PEG parser into a context-free parser
terminalPEG :: (Applicative m, Monoid s, Ord s) => Backtrack.Parser g s a -> ParserT m g s a
terminalPEG :: forall (m :: * -> *) s (g :: (* -> *) -> *) a.
(Applicative m, Monoid s, Ord s) =>
Parser g s a -> ParserT m g s a
terminalPEG Parser g s a
p = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q where
   q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [] = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p forall a. Monoid a => a
mempty
            of Backtrack.Parsed Int
l a
result s
_ -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l [] a
result
               Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure
   q rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_) = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
                       of Backtrack.Parsed Int
l a
result s
_ -> forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Applicative m, Ord s) =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) a
result
                          Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure

fromResultList :: (Functor m, Eq s, FactorialMonoid s) => ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList :: forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList (ResultList [] (ParseFailure Down Int
pos FailureDescription s
positive [String]
negative)) = forall a b. a -> Either a b
Left (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Down Int
pos forall a. Num a => a -> a -> a
- Down Int
1) FailureDescription s
positive [String]
negative)
fromResultList (ResultList [ResultsOfLengthT m g s r]
rl ParseFailure (Down Int) s
_failure) = forall a b. b -> Either a b
Right (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {m :: * -> *} {g :: (* -> *) -> *} {r}.
Monoid a =>
ResultsOfLengthT m g a r -> [(a, m r)]
f [ResultsOfLengthT m g s r]
rl)
   where f :: ResultsOfLengthT m g a r -> [(a, m r)]
f (ResultsOfLengthT (ROL Int
_ ((a
s, g (ResultListT m g a)
_):[(a, g (ResultListT m g a))]
_) NonEmpty (m r)
r)) = (,) a
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
         f (ResultsOfLengthT (ROL Int
_ [] NonEmpty (m r)
r)) = (,) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
{-# INLINABLE fromResultList #-}

instance Functor (ResultsOfLength m g s) where
   fmap :: forall a b.
(a -> b) -> ResultsOfLength m g s a -> ResultsOfLength m g s b
fmap a -> b
f (ROL Int
l [(s, g (ResultListT m g s))]
t NonEmpty a
a) = forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l [(s, g (ResultListT m g s))]
t (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
a)
   {-# INLINE fmap #-}

instance Functor m => Functor (ResultsOfLengthT m g s) where
   fmap :: forall a b.
(a -> b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
fmap a -> b
f (ResultsOfLengthT ResultsOfLength m g s (m a)
rol) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultsOfLength m g s (m a)
rol)
   {-# INLINE fmap #-}

instance Functor m => Functor (ResultListT m g s) where
   fmap :: forall a b. (a -> b) -> ResultListT m g s a -> ResultListT m g s b
fmap a -> b
f (ResultList [ResultsOfLengthT m g s a]
l ParseFailure (Down Int) s
failure) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList ((a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
l) ParseFailure (Down Int) s
failure
   {-# INLINE fmap #-}

instance (Applicative m, Ord s) => Applicative (ResultsOfLength m g s) where
   pure :: forall a. a -> ResultsOfLength m g s a
pure = forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   ROL Int
l1 [(s, g (ResultListT m g s))]
_ NonEmpty (a -> b)
fs <*> :: forall a b.
ResultsOfLength m g s (a -> b)
-> ResultsOfLength m g s a -> ResultsOfLength m g s b
<*> ROL Int
l2 [(s, g (ResultListT m g s))]
t2 NonEmpty a
xs = forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
l1 forall a. Num a => a -> a -> a
+ Int
l2) [(s, g (ResultListT m g s))]
t2 (NonEmpty (a -> b)
fs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty a
xs)
   {-# INLINE pure #-}
   {-# INLINE (<*>) #-}

instance (Applicative m, Ord s) => Applicative (ResultsOfLengthT m g s) where
   pure :: forall a. a -> ResultsOfLengthT m g s a
pure = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   ResultsOfLengthT ResultsOfLength m g s (m (a -> b))
rol1 <*> :: forall a b.
ResultsOfLengthT m g s (a -> b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
<*> ResultsOfLengthT ResultsOfLength m g s (m a)
rol2 = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ResultsOfLength m g s (m (a -> b))
rol1 ResultsOfLength m g s (m a)
rol2)

instance (Applicative m, Ord s) => Applicative (ResultListT m g s) where
   pure :: forall a. a -> ResultListT m g s a
pure a
a = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList [forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a] forall a. Monoid a => a
mempty
   ResultList [ResultsOfLengthT m g s (a -> b)]
rl1 ParseFailure (Down Int) s
f1 <*> :: forall a b.
ResultListT m g s (a -> b)
-> ResultListT m g s a -> ResultListT m g s b
<*> ResultList [ResultsOfLengthT m g s a]
rl2 ParseFailure (Down Int) s
f2 = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s (a -> b)]
rl1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ResultsOfLengthT m g s a]
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)

instance (Applicative m, Ord s) => Alternative (ResultListT m g s) where
   empty :: forall a. ResultListT m g s a
empty = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
   <|> :: forall a.
ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
(<|>) = forall a. Semigroup a => a -> a -> a
(<>)

instance (Applicative m, Ord s) => AmbiguousAlternative (ResultListT m g s) where
   ambiguousOr :: forall a.
ResultListT m g s (Ambiguous a)
-> ResultListT m g s (Ambiguous a)
-> ResultListT m g s (Ambiguous a)
ambiguousOr (ResultList [ResultsOfLengthT m g s (Ambiguous a)]
rl1 ParseFailure (Down Int) s
f1) (ResultList [ResultsOfLengthT m g s (Ambiguous a)]
rl2 ParseFailure (Down Int) s
f2) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {a}.
Applicative m =>
[ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [ResultsOfLengthT m g s (Ambiguous a)]
rl1 [ResultsOfLengthT m g s (Ambiguous a)]
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
      where merge :: [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [] [ResultsOfLengthT m g s (Ambiguous a)]
rl = [ResultsOfLengthT m g s (Ambiguous a)]
rl
            merge [ResultsOfLengthT m g s (Ambiguous a)]
rl [] = [ResultsOfLengthT m g s (Ambiguous a)]
rl
            merge rl1' :: [ResultsOfLengthT m g s (Ambiguous a)]
rl1'@(rol1 :: ResultsOfLengthT m g s (Ambiguous a)
rol1@(ResultsOfLengthT (ROL Int
l1 [(s, g (ResultListT m g s))]
s1 NonEmpty (m (Ambiguous a))
r1)) : [ResultsOfLengthT m g s (Ambiguous a)]
rest1)
                  rl2' :: [ResultsOfLengthT m g s (Ambiguous a)]
rl2'@(rol2 :: ResultsOfLengthT m g s (Ambiguous a)
rol2@(ResultsOfLengthT (ROL Int
l2 [(s, g (ResultListT m g s))]
_ NonEmpty (m (Ambiguous a))
r2)) : [ResultsOfLengthT m g s (Ambiguous a)]
rest2)
               | Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLengthT m g s (Ambiguous a)
rol1 forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [ResultsOfLengthT m g s (Ambiguous a)]
rest1 [ResultsOfLengthT m g s (Ambiguous a)]
rl2'
               | Int
l1 forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLengthT m g s (Ambiguous a)
rol2 forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [ResultsOfLengthT m g s (Ambiguous a)]
rl1' [ResultsOfLengthT m g s (Ambiguous a)]
rest2
               | Bool
otherwise = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l1 [(s, g (ResultListT m g s))]
s1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {a}. Ambiguous a -> Ambiguous a -> Ambiguous a
collect) NonEmpty (m (Ambiguous a))
r1 NonEmpty (m (Ambiguous a))
r2) forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [ResultsOfLengthT m g s (Ambiguous a)]
rest1 [ResultsOfLengthT m g s (Ambiguous a)]
rest2
            collect :: Ambiguous a -> Ambiguous a -> Ambiguous a
collect (Ambiguous NonEmpty a
xs) (Ambiguous NonEmpty a
ys) = forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty a
xs forall a. Semigroup a => a -> a -> a
<> NonEmpty a
ys)

instance Traversable m => Filterable (ResultListT m g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> ResultListT m g s a -> ResultListT m g s b
   mapMaybe :: forall a b.
(a -> Maybe b) -> ResultListT m g s a -> ResultListT m g s b
mapMaybe a -> Maybe b
f (ResultList [ResultsOfLengthT m g s a]
rs ParseFailure (Down Int) s
failure) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ResultsOfLengthT m g s a -> Maybe (ResultsOfLengthT m g s b)
filterResults [ResultsOfLengthT m g s a]
rs) ParseFailure (Down Int) s
failure
      where filterResults :: ResultsOfLengthT m g s a -> Maybe (ResultsOfLengthT m g s b)
            filterResults :: ResultsOfLengthT m g s a -> Maybe (ResultsOfLengthT m g s b)
filterResults (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
t NonEmpty (m a)
as)) =
               forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l [(s, g (ResultListT m g s))]
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (m a)
as)

instance {-# overlaps #-} (Monad m, Traversable m, Monoid state) => Filterable (ResultListT (StateT state m) g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> ResultListT (StateT state m) g s a -> ResultListT (StateT state m) g s b
   mapMaybe :: forall a b.
(a -> Maybe b)
-> ResultListT (StateT state m) g s a
-> ResultListT (StateT state m) g s b
mapMaybe a -> Maybe b
f (ResultList [ResultsOfLengthT (StateT state m) g s a]
rs ParseFailure (Down Int) s
failure) = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ResultsOfLengthT (StateT state m) g s a
-> Maybe (ResultsOfLengthT (StateT state m) g s b)
filterResults [ResultsOfLengthT (StateT state m) g s a]
rs) ParseFailure (Down Int) s
failure
      where filterResults :: ResultsOfLengthT (StateT state m) g s a -> Maybe (ResultsOfLengthT (StateT state m) g s b)
            filterResults :: ResultsOfLengthT (StateT state m) g s a
-> Maybe (ResultsOfLengthT (StateT state m) g s b)
filterResults (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT (StateT state m) g s))]
t NonEmpty (StateT state m a)
as)) =
               forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l [(s, g (ResultListT (StateT state m) g s))]
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe StateT state m a -> Maybe (StateT state m b)
traverseWithMonoid forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (StateT state m a)
as)
            traverseWithMonoid :: StateT state m a -> Maybe (StateT state m b)
            traverseWithMonoid :: StateT state m a -> Maybe (StateT state m b)
traverseWithMonoid StateT state m a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT state m a
m forall a. Monoid a => a
mempty)

instance Ord s => Semigroup (ResultListT m g s r) where
   ResultList [ResultsOfLengthT m g s r]
rl1 ParseFailure (Down Int) s
f1 <> :: ResultListT m g s r -> ResultListT m g s r -> ResultListT m g s r
<> ResultList [ResultsOfLengthT m g s r]
rl2 ParseFailure (Down Int) s
f2 = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList (forall {m :: * -> *} {g :: (* -> *) -> *} {s} {r}.
[ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [ResultsOfLengthT m g s r]
rl1 [ResultsOfLengthT m g s r]
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
      where merge :: [ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [] [ResultsOfLengthT m g s r]
rl = [ResultsOfLengthT m g s r]
rl
            merge [ResultsOfLengthT m g s r]
rl [] = [ResultsOfLengthT m g s r]
rl
            merge rl1' :: [ResultsOfLengthT m g s r]
rl1'@(rol1 :: ResultsOfLengthT m g s r
rol1@(ResultsOfLengthT (ROL Int
l1 [(s, g (ResultListT m g s))]
s1 NonEmpty (m r)
r1)) : [ResultsOfLengthT m g s r]
rest1)
                 rl2' :: [ResultsOfLengthT m g s r]
rl2'@(rol2 :: ResultsOfLengthT m g s r
rol2@(ResultsOfLengthT (ROL Int
l2 [(s, g (ResultListT m g s))]
_ NonEmpty (m r)
r2)) : [ResultsOfLengthT m g s r]
rest2)
               | Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLengthT m g s r
rol1 forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [ResultsOfLengthT m g s r]
rest1 [ResultsOfLengthT m g s r]
rl2'
               | Int
l1 forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLengthT m g s r
rol2 forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [ResultsOfLengthT m g s r]
rl1' [ResultsOfLengthT m g s r]
rest2
               | Bool
otherwise = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
l1 [(s, g (ResultListT m g s))]
s1 (NonEmpty (m r)
r1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (m r)
r2)) forall a. a -> [a] -> [a]
: [ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [ResultsOfLengthT m g s r]
rest1 [ResultsOfLengthT m g s r]
rest2

instance Ord s => Monoid (ResultListT m g s r) where
   mempty :: ResultListT m g s r
mempty = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
   mappend :: ResultListT m g s r -> ResultListT m g s r -> ResultListT m g s r
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance FallibleResults (ResultListT m g) where
   hasSuccess :: forall s a. ResultListT m g s a -> Bool
hasSuccess (ResultList [] ParseFailure (Down Int) s
_) = Bool
False
   hasSuccess ResultListT m g s a
_ = Bool
True
   failureOf :: forall s a. ResultListT m g s a -> ParseFailure (Down Int) s
failureOf (ResultList [ResultsOfLengthT m g s a]
_ ParseFailure (Down Int) s
failure) = ParseFailure (Down Int) s
failure
   failWith :: forall s a. ParseFailure (Down Int) s -> ResultListT m g s a
failWith = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure (Down Int) s -> ResultListT m g s r
ResultList []