{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,
RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
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)
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)
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 :: 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)
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)
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
(<>)
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
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 :: 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
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
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))
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")]
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)
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 []