{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,
RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.SortedMemoizing.Transformer (ResultListT(..), ParserT(..), (<<|>),
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.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.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 (expected, 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{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{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{ResultListT m g s r -> [ResultsOfLengthT m g s r]
resultSuccesses :: ![ResultsOfLengthT m g s r],
ResultListT m g s r -> ParseFailure Pos s
resultFailures :: !(ParseFailure Pos s)}
singleResult :: (Applicative m, Ord s) => Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult :: 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 = [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r)
-> ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
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 (r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
am r -> [m r] -> NonEmpty (m r)
forall a. a -> [a] -> NonEmpty a
:|[])] ParseFailure Pos s
forall a. Monoid a => a
mempty
instance Functor m => Functor (ParserT m g s) where
fmap :: (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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((a -> b) -> ResultListT m g s a -> ResultListT m g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
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 :: a -> ParserT m g s a
pure a
a = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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-> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
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 <*> :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
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 Pos s
failure -> [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s b]
forall a. Monoid a => a
mempty ParseFailure Pos s
failure ResultListT m g s b -> ResultListT m g s b -> ResultListT m g s b
forall a. Semigroup a => a -> a -> a
<> (ResultsOfLengthT m g s (a -> b) -> ResultListT m g s b)
-> [ResultsOfLengthT m g s (a -> b)] -> ResultListT m g s b
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)) = (m (a -> b) -> ResultListT m g s b)
-> NonEmpty (m (a -> b)) -> ResultListT m g s b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> ResultListT m g s a -> m (a -> b) -> ResultListT m g s b
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 (ResultListT m g s a -> m (a -> b) -> ResultListT m g s b)
-> ResultListT m g s a -> m (a -> b) -> ResultListT m g s b
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 Pos s
failure) m (a -> r)
f = [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList (Int
-> m (a -> r)
-> ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s r
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 (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s r)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs) ParseFailure Pos 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)) = ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultListT m g s))]
rest' ((m (a -> r)
f m (a -> r) -> m a -> m r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) (m a -> m r) -> NonEmpty (m a) -> NonEmpty (m r)
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 :: ParserT m g s a
empty = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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-> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultListT m g s a)
-> ParseFailure Pos s -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 <|> :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
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 :: (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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((a -> Maybe b) -> ResultListT m g s a -> ResultListT m g s b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
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 :: (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) = ([(s, g (ResultListT (StateT state m) g s))]
-> ResultListT (StateT state m) g s b)
-> ParserT (StateT state m) g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((a -> Maybe b)
-> ResultListT (StateT state m) g s a
-> ResultListT (StateT state m) g s b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f (ResultListT (StateT state m) g s a
-> ResultListT (StateT state m) g s b)
-> ([(s, g (ResultListT (StateT state m) g s))]
-> ResultListT (StateT state m) g s a)
-> [(s, g (ResultListT (StateT state m) g s))]
-> ResultListT (StateT state m) g s b
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 :: a -> ParserT m g s a
return = a -> ParserT m g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: ParserT m g s a -> ParserT m g s b -> ParserT m g s 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 >>= :: ParserT m g s a -> (a -> ParserT m g s b) -> ParserT m g s b
>>= a -> ParserT m g s b
f = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
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 Pos s
failure -> [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s b]
forall a. Monoid a => a
mempty ParseFailure Pos s
failure ResultListT m g s b -> ResultListT m g s b -> ResultListT m g s b
forall a. Semigroup a => a -> a -> a
<> (ResultsOfLengthT m g s a -> ResultListT m g s b)
-> [ResultsOfLengthT m g s a] -> ResultListT m g s b
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)) = (m a -> ResultListT m g s b)
-> NonEmpty (m a) -> ResultListT m g s b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> ResultListT m g s b -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
Int -> ResultListT m g s r -> ResultListT m g s r
continue' Int
l (ResultListT m g s b -> ResultListT m g s b)
-> (m a -> ResultListT m g s b) -> m a -> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParserT m g s b
-> [(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> [(s, g (ResultListT m g s))]
-> ParserT m g s b
-> ResultListT m g s b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserT m g s b
-> [(s, g (ResultListT m g s))] -> ResultListT m g s b
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' (ParserT m g s b -> ResultListT m g s b)
-> (m a -> ParserT m g s b) -> m a -> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (ParserT m g s b) -> ParserT m g s b
forall a. m (ParserT m g s a) -> ParserT m g s a
rejoin (m (ParserT m g s b) -> ParserT m g s b)
-> (m a -> m (ParserT m g s b)) -> m a -> ParserT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ParserT m g s b) -> m a -> m (ParserT m g s b)
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 Pos s
failure) = [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList (Int -> ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
Int -> ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r
adjust Int
l (ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r)
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s r]
rs) ParseFailure Pos 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)) = ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
lInt -> Int -> Int
forall 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 :: m (ParserT m g s a) -> ParserT m g s a
rejoin m (ParserT m g s a)
m = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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-> m (ResultListT m g s a) -> ResultListT m g s a
forall a. m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults (m (ResultListT m g s a) -> ResultListT m g s a)
-> m (ResultListT m g s a) -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ (ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ParserT m g s a
-> ResultListT m g s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
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 (ParserT m g s a -> ResultListT m g s a)
-> m (ParserT m g s a) -> m (ResultListT m g s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ParserT m g s a)
m)
rejoinResults :: m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults m (ResultListT m g s a)
m = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a)
-> [m (ResultsOfLengthT m g s a)] -> [ResultsOfLengthT m g s a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
forall a. m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
rejoinResultsOfLengthT ([m (ResultsOfLengthT m g s a)] -> [ResultsOfLengthT m g s a])
-> [m (ResultsOfLengthT m g s a)] -> [ResultsOfLengthT m g s a]
forall a b. (a -> b) -> a -> b
$ m [ResultsOfLengthT m g s a] -> [m (ResultsOfLengthT m g s a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (m [ResultsOfLengthT m g s a] -> [m (ResultsOfLengthT m g s a)])
-> m [ResultsOfLengthT m g s a] -> [m (ResultsOfLengthT m g s a)]
forall a b. (a -> b) -> a -> b
$ ResultListT m g s a -> [ResultsOfLengthT m g s a]
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> [ResultsOfLengthT m g s r]
resultSuccesses (ResultListT m g s a -> [ResultsOfLengthT m g s a])
-> m (ResultListT m g s a) -> m [ResultsOfLengthT m g s a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ResultListT m g s a)
m) ((ResultListT m g s a -> ParseFailure Pos s)
-> m (ResultListT m g s a) -> ParseFailure Pos s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultListT m g s a -> ParseFailure Pos s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> ParseFailure Pos s
resultFailures m (ResultListT m g s a)
m)
rejoinResultsOfLengthT :: m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
rejoinResultsOfLengthT m (ResultsOfLengthT m g s a)
m = ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a)
-> ResultsOfLength m g s (m (m a)) -> ResultsOfLength m g s (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResultsOfLengthT m g s a -> ResultsOfLength m g s (m a))
-> m (ResultsOfLengthT m g s a) -> ResultsOfLength m g s (m (m a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ResultsOfLengthT m g s a -> ResultsOfLength m g s (m a)
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 :: String -> ParserT m g s a
fail String
msg = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])
instance (Foldable m, Monad m, Traversable m, Ord s) => MonadPlus (ParserT m g s) where
mzero :: ParserT m g s a
mzero = ParserT m g s a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: ParserT m g s a -> ParserT m g s a -> ParserT m g s a
mplus = ParserT m g s a -> ParserT m g s a -> ParserT m g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
lift :: Ord s => m a -> ParserT m g s a
lift :: m a -> ParserT m g s a
lift m a
m = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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-> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a)
-> ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m a)
-> ResultsOfLength m g s (m a)
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
mm a -> [m a] -> NonEmpty (m a)
forall a. a -> [a] -> NonEmpty a
:|[])] ParseFailure Pos s
forall a. Monoid a => a
mempty)
tbind :: Monad m => ParserT m g s a -> (a -> m b) -> ParserT m g s b
tbind :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((a -> m b) -> ResultListT m g s a -> ResultListT m g s b
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 (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
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 :: (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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
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 (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
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 :: (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 Pos s
failures) = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
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 m g s a -> ResultsOfLengthT m g s b)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
successes) ParseFailure Pos s
failures
mapResultList :: (m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList :: (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 Pos s
failures) = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((m a -> m b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
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 m g s a -> ResultsOfLengthT m g s b)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
successes) ParseFailure Pos s
failures
bindResults :: Monad m => (a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
bindResults :: (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)) = ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m b)
-> ResultsOfLength m g s (m 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 a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
f) (m a -> m b) -> NonEmpty (m a) -> NonEmpty (m b)
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 :: (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) = ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (m a -> m b
f (m a -> m b)
-> ResultsOfLength m g s (m a) -> ResultsOfLength m g s (m b)
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
(<>) = (x -> x -> x)
-> 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 x -> x -> x
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 = x -> ParserT m g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
mappend :: ParserT m g s x -> ParserT m g s x -> ParserT m g s x
mappend = ParserT m g s x -> ParserT m g s x -> ParserT m g s x
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 :: g (ParserT m g s)
-> s -> g (Compose (ResultFunctor (ParserT m g s)) ((,) s))
parsePrefix g (ParserT m g s)
g s
input = (forall a.
ResultListT m g s a
-> Compose (Compose (Compose (ParseResults s) []) m) ((,) s) a)
-> g (ResultListT m g s)
-> g (Compose (Compose (Compose (ParseResults s) []) m) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (Compose (ParseResults s) []) m (s, a)
-> Compose (Compose (Compose (ParseResults s) []) m) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Compose (ParseResults s) []) m (s, a)
-> Compose (Compose (Compose (ParseResults s) []) m) ((,) s) a)
-> (ResultListT m g s a
-> Compose (Compose (ParseResults s) []) m (s, a))
-> ResultListT m g s a
-> Compose (Compose (Compose (ParseResults s) []) m) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (ParseResults s) [] (m (s, a))
-> Compose (Compose (ParseResults s) []) m (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (ParseResults s) [] (m (s, a))
-> Compose (Compose (ParseResults s) []) m (s, a))
-> (ResultListT m g s a -> Compose (ParseResults s) [] (m (s, a)))
-> ResultListT m g s a
-> Compose (Compose (ParseResults s) []) m (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [m (s, a)]
-> Compose (ParseResults s) [] (m (s, a))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [m (s, a)]
-> Compose (ParseResults s) [] (m (s, a)))
-> (ResultListT m g s a -> Either (ParseFailure Pos s) [m (s, a)])
-> ResultListT m g s a
-> Compose (ParseResults s) [] (m (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(s, m a)] -> [m (s, a)])
-> Either (ParseFailure Pos s) [(s, m a)]
-> Either (ParseFailure Pos s) [m (s, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s, m a) -> m (s, a)) -> [(s, m a)] -> [m (s, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, m a) -> m (s, a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) (Either (ParseFailure Pos s) [(s, m a)]
-> Either (ParseFailure Pos s) [m (s, a)])
-> (ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)])
-> ResultListT m g s a
-> Either (ParseFailure Pos s) [m (s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)]
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList)
((s, g (ResultListT m g s)) -> g (ResultListT m g s)
forall a b. (a, b) -> b
snd ((s, g (ResultListT m g s)) -> g (ResultListT m g s))
-> (s, g (ResultListT m g s)) -> g (ResultListT m g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a. [a] -> a
head ([(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s)))
-> [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a b. (a -> b) -> a -> b
$ g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
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 (ParserT m g s)
g s
s
input)
parseComplete :: g (ParserT m g s) -> s -> g (ResultFunctor (ParserT m g s))
parseComplete g (ParserT m g s)
g s
input = (forall a.
ResultListT m g s a -> Compose (Compose (ParseResults s) []) m a)
-> g (ResultListT m g s)
-> g (Compose (Compose (ParseResults s) []) m)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (ParseResults s) [] (m a)
-> Compose (Compose (ParseResults s) []) m a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (ParseResults s) [] (m a)
-> Compose (Compose (ParseResults s) []) m a)
-> (ResultListT m g s a -> Compose (ParseResults s) [] (m a))
-> ResultListT m g s a
-> Compose (Compose (ParseResults s) []) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, m a) -> m a)
-> Compose (ParseResults s) [] (s, m a)
-> Compose (ParseResults s) [] (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, m a) -> m a
forall a b. (a, b) -> b
snd (Compose (ParseResults s) [] (s, m a)
-> Compose (ParseResults s) [] (m a))
-> (ResultListT m g s a -> Compose (ParseResults s) [] (s, m a))
-> ResultListT m g s a
-> Compose (ParseResults s) [] (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [(s, m a)]
-> Compose (ParseResults s) [] (s, m a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [(s, m a)]
-> Compose (ParseResults s) [] (s, m a))
-> (ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)])
-> ResultListT m g s a
-> Compose (ParseResults s) [] (s, m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)]
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList)
((s, g (ResultListT m g s)) -> g (ResultListT m g s)
forall a b. (a, b) -> b
snd ((s, g (ResultListT m g s)) -> g (ResultListT m g s))
-> (s, g (ResultListT m g s)) -> g (ResultListT m g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a. [a] -> a
head ([(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s)))
-> [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a b. (a -> b) -> a -> b
$ g (ParserT m g s)
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
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 ([(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))])
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
forall a b. (a -> b) -> a -> b
$ g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
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 (ParserT m g s)
g s
s
input)
where close :: g (ParserT m g s)
close = (forall a. ParserT m g s a -> ParserT m g s a)
-> g (ParserT m g s) -> g (ParserT m g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (ParserT m g s a -> ParserT m g s () -> ParserT m g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT m g s ()
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 :: 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)
_ = Compose (Either (ParseFailure Pos s)) [] (m (s, a))
-> Compose (Compose (Either (ParseFailure Pos s)) []) m (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure Pos s)) [] (m (s, a))
-> Compose (Compose (Either (ParseFailure Pos s)) []) m (s, a))
-> (ResultListT m g s a
-> Compose (Either (ParseFailure Pos s)) [] (m (s, a)))
-> ResultListT m g s a
-> Compose (Compose (Either (ParseFailure Pos s)) []) m (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [m (s, a)]
-> Compose (Either (ParseFailure Pos s)) [] (m (s, a))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [m (s, a)]
-> Compose (Either (ParseFailure Pos s)) [] (m (s, a)))
-> (ResultListT m g s a -> Either (ParseFailure Pos s) [m (s, a)])
-> ResultListT m g s a
-> Compose (Either (ParseFailure Pos s)) [] (m (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(s, m a)] -> [m (s, a)])
-> Either (ParseFailure Pos s) [(s, m a)]
-> Either (ParseFailure Pos s) [m (s, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s, m a) -> m (s, a)) -> [(s, m a)] -> [m (s, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, m a) -> m (s, a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) (Either (ParseFailure Pos s) [(s, m a)]
-> Either (ParseFailure Pos s) [m (s, a)])
-> (ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)])
-> ResultListT m g s a
-> Either (ParseFailure Pos s) [m (s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultListT m g s a -> Either (ParseFailure Pos s) [(s, m a)]
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 :: (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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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))]
_) = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
rs' ParseFailure Pos s
failure
where ResultList [ResultsOfLengthT m g s a]
rs ParseFailure Pos 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 (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s a]
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)) = ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m a)
-> ResultsOfLength m g s (m a)
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))]
_ = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"NonTerminal at endOfInput")
{-# INLINE nonTerminal #-}
instance (Applicative m, Ord s, LeftReductive s, FactorialMonoid s, Rank2.Functor g) =>
TailsParsing (ParserT m g s) where
parseTails :: ParserT m g s r
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
-> GrammarFunctor (ParserT m g s) r
parseTails = ParserT m g s r
-> [(ParserInput (ParserT m g s),
g (GrammarFunctor (ParserT m g s)))]
-> GrammarFunctor (ParserT m g s) r
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 :: g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails g (ParserT m g s)
g s
input = (s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))])
-> [(s, g (ResultListT m g s))]
-> [s]
-> [(s, g (ResultListT m g s))]
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 [] (s -> [s]
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)(s, g (ResultListT m g s))
-> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultListT m g s))]
parsedTail
d :: g (ResultListT m g s)
d = (forall a. ParserT m g s a -> ResultListT m g s a)
-> g (ParserT m g s) -> g (ResultListT m g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))]
parsed) (([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ResultListT m g s a)
-> (ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
-> ResultListT m g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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
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))]
_) = Int -> [(r, g (ResultListT m g r))] -> r -> ResultListT m g r 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 [] = Int -> [(r, g (ResultListT m g r))] -> r -> ResultListT m g r 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
forall a. Monoid a => a
mempty
anyToken :: ParserT m g s (ParserInput (ParserT m g s))
anyToken = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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
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 r -> Maybe (r, r)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
of Just (r
first, r
_) -> Int -> [(r, g (ResultListT m g r))] -> r -> ResultListT m g r 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)
_ -> [ResultsOfLengthT m g r r]
-> ParseFailure Pos r -> ResultListT m g r r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g r r]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos r
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(r, g (ResultListT m g r))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(r, g (ResultListT m g r))]
rest) String
"anyToken")
p [] = [ResultsOfLengthT m g r r]
-> ParseFailure Pos r -> ResultListT m g r r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g r r]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos r
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
t) =
case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
of Just (s
first, s
_) | ParserInput (ParserT m g s) -> Bool
predicate s
ParserInput (ParserT m g s)
first -> Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
1 [(s, g (ResultListT m g s))]
t s
first
Maybe (s, s)
_ -> [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"satisfy")
p [] = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"satisfy")
scan :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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 (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))]
_) = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
prefix
where (s
prefix, s
_, state
_) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (ParserT m g s) -> Maybe state
f s
i
l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
p state
_ [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (ParserT m g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
p [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
forall a. Monoid a => a
mempty
take :: Int -> ParserT m g s (ParserInput (ParserT m g s))
take Int
0 = ParserT m g s (ParserInput (ParserT m g s))
forall a. Monoid a => a
mempty
take Int
n = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
x <- Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n =
Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
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 = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) (String -> ParseFailure Pos s) -> String -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (ParserT m g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
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 = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
ParserInput (ParserT m g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
ParserInput (ParserT m g s)
s
p [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) [s -> FailureDescription s
forall s. s -> FailureDescription s
LiteralDescription s
ParserInput (ParserT m g s)
s] [])
l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g 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 ()
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
_) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s,
ParserInput (ParserT m g s) -> Bool
predicate s
ParserInput (ParserT m g s)
first = [ResultsOfLengthT m g s ()]
-> ParseFailure Pos s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 = Int -> [(s, g (ResultListT m g s))] -> () -> 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
0 [(s, g (ResultListT m g s))]
rest ()
{-# INLINABLE string #-}
instance InputParsing (ParserT m g s) => TraceableParsing (ParserT m g s) where
traceInput :: (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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Parsing " ([(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 Pos s
_) -> String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Failed " ResultListT m g s a
rl
ResultListT m g s a
rl -> String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Parsed " ResultListT m g s a
rl
where traceWith :: String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
prefix = String -> ResultListT m g s a -> ResultListT m g s a
forall a. String -> a -> a
trace (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> case [(s, g (ResultListT m g s))]
rest of ((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_) -> ParserInput (ParserT m g s) -> String
description s
ParserInput (ParserT m g s)
s; [] -> String
"EOF")
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
t) =
case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first
| Char -> Bool
predicate Char
first -> Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
1 [(s, g (ResultListT m g s))]
t (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s)
Maybe Char
_ -> [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"satisfyCharInput")
p [] = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"satisfyCharInput")
scanChars :: state
-> (state -> Char -> Maybe state)
-> ParserT m g s (ParserInput (ParserT m g s))
scanChars state
s0 state -> Char -> Maybe state
f = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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 (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))]
_) = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
prefix
where (s
prefix, s
_, state
_) = state -> (state -> Char -> Maybe state) -> s -> (s, 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 = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
p state
_ [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
forall a. Monoid a => a
mempty
takeCharsWhile :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile Char -> Bool
predicate = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) s
x
p [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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
forall a. Monoid a => a
mempty
takeCharsWhile1 :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile1 Char -> Bool
predicate = ([(s, g (ResultListT m g s))] -> ResultListT m g s s)
-> 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))]
_)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g 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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
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 = [ResultsOfLengthT m g s s]
-> ParseFailure Pos s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g 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 ()
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 <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s,
Char -> Bool
predicate Char
first = [ResultsOfLengthT m g s ()]
-> ParseFailure Pos s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 = Int -> [(s, g (ResultListT m g s))] -> () -> 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
0 [(s, g (ResultListT m g s))]
rest ()
instance (Applicative m, LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (ParserT m g s) where
match :: 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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s (s, a))
-> ParserT m g s (s, 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))] -> ResultListT m g s (s, a)
q
where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s (s, a)
q [] = s -> ResultListT m g s a -> ResultListT m g s (s, a)
forall (m :: * -> *) a (g :: (* -> *) -> *) s b.
(Functor m, FactorialMonoid a) =>
a -> ResultListT m g s b -> ResultListT m g s (a, b)
addConsumed s
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))]
_) = s -> ResultListT m g s a -> ResultListT m g s (s, a)
forall (m :: * -> *) a (g :: (* -> *) -> *) s b.
(Functor m, FactorialMonoid a) =>
a -> ResultListT m g s b -> ResultListT m g s (a, b)
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 b -> ResultListT m g s (a, b)
addConsumed a
input (ResultList [ResultsOfLengthT m g s b]
rl ParseFailure Pos s
failure) = [ResultsOfLengthT m g s (a, b)]
-> ParseFailure Pos s -> ResultListT m g s (a, b)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList (ResultsOfLengthT m g s b -> ResultsOfLengthT m g s (a, b)
add1 (ResultsOfLengthT m g s b -> ResultsOfLengthT m g s (a, b))
-> [ResultsOfLengthT m g s b] -> [ResultsOfLengthT m g s (a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s b]
rl) ParseFailure Pos s
failure
where add1 :: ResultsOfLengthT m g s b -> ResultsOfLengthT m g s (a, b)
add1 (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT m g s))]
t NonEmpty (m b)
rs)) =
ResultsOfLength m g s (m (a, b)) -> ResultsOfLengthT m g s (a, b)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m (a, b))
-> ResultsOfLength m g s (m (a, b))
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 (NonEmpty (m (a, b)) -> ResultsOfLength m g s (m (a, b)))
-> NonEmpty (m (a, b)) -> ResultsOfLength m g s (m (a, b))
forall a b. (a -> b) -> a -> b
$ ((,) (Int -> a -> a
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
l a
input) (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m b -> m (a, b)) -> NonEmpty (m b) -> NonEmpty (m (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m b)
rs)
instance (Applicative m, MonoidNull s, Ord s) => Parsing (ParserT m g s) where
try :: ParserT m g s a -> ParserT m g s a
try (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 Pos s
_) = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
rl (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
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 <?> :: ParserT m g s a -> String -> ParserT m g s a
<?> String
msg = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 Pos
pos [FailureDescription s]
msgs [FailureDescription s]
erroneous)) =
[ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [] (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos (if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Pos
forall a. a -> Down a
Down ([(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) then [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg]
else [FailureDescription s]
msgs) [FailureDescription s]
erroneous)
replaceFailure ResultListT m g s a
rl = ResultListT m g s a
rl
notFollowedBy :: ParserT m g s a -> ParserT m g s ()
notFollowedBy (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g 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))]
input-> [(s, g (ResultListT m g s))]
-> ResultListT m g s a -> ResultListT m g s ()
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 Pos s
_) = Int -> [(s, g (ResultListT m g s))] -> () -> 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
0 [(s, g (ResultListT m g s))]
t ()
rewind [(s, g (ResultListT m g s))]
t ResultList{} = [ResultsOfLengthT m g s ()]
-> ParseFailure Pos s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
t) String
"notFollowedBy")
skipMany :: 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 = () -> ParserT m g s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () ParserT m g s () -> ParserT m g s () -> ParserT m g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT m g s a -> ParserT m g s a
forall (m :: * -> *) a. Parsing m => m a -> m a
try ParserT m g s a
p ParserT m g s a -> ParserT m g s () -> ParserT m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT m g s ()
go
unexpected :: String -> ParserT m g s a
unexpected String
msg = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))]
t-> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultListT m g s a)
-> ParseFailure Pos s -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
t) String
msg)
eof :: ParserT m g s ()
eof = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g 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 ()
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))]
_)
| s -> Bool
forall m. MonoidNull m => m -> Bool
null s
s = Int -> [(s, g (ResultListT m g s))] -> () -> 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
0 [(s, g (ResultListT m g s))]
rest ()
| Bool
otherwise = [ResultsOfLengthT m g s ()]
-> ParseFailure Pos s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"end of input")
f [] = Int -> [(s, g (ResultListT m g s))] -> () -> 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
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 <<|> :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 Pos s
_failure) -> ResultListT m g s a
rl ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
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 :: ParserT m g s a -> ParserT m g s [a]
takeSome ParserT m g s a
p = (:) (a -> [a] -> [a]) -> ParserT m g s a -> ParserT m g s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT m g s a
p ParserT m g s ([a] -> [a])
-> ParserT m g s [a] -> ParserT m g s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT m g s a -> ParserT m g s [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany ParserT m g s a
p
takeMany :: ParserT m g s a -> ParserT m g s [a]
takeMany (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s [a])
-> ParserT m g s [a]
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 (([a] -> [a]) -> m ([a] -> [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
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 Pos s
_failure
-> [ResultsOfLengthT m g s [a]]
-> ParseFailure Pos s -> ResultListT m g s [a]
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m [a]) -> ResultsOfLengthT m g s [a]
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m [a]) -> ResultsOfLengthT m g s [a])
-> ResultsOfLength m g s (m [a]) -> ResultsOfLengthT m g s [a]
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m [a])
-> ResultsOfLength m g s (m [a])
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 ((([a] -> [a]) -> [a]) -> m ([a] -> [a]) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ []) m ([a] -> [a])
acc m [a] -> [m [a]] -> NonEmpty (m [a])
forall a. a -> [a] -> NonEmpty a
:| [])] ParseFailure Pos s
forall a. Monoid a => a
mempty
ResultList [ResultsOfLengthT m g s a]
rl ParseFailure Pos s
_ -> (ResultsOfLengthT m g s a -> ResultListT m g s [a])
-> [ResultsOfLengthT m g s a] -> ResultListT m g s [a]
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)) =
(m a -> ResultListT m g s [a])
-> NonEmpty (m a) -> ResultListT m g s [a]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') ((([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> m ([a] -> [a]) -> m ([a] -> [a]) -> m ([a] -> [a])
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) m ([a] -> [a])
acc ((:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
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 :: ParserT m g s a -> ParserT m g s ()
skipAll (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g s ()
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 (() -> m ()
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 Pos s
_failure -> [ResultsOfLengthT m g s ()]
-> ParseFailure Pos s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m ()) -> ResultsOfLengthT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m ()) -> ResultsOfLengthT m g s ())
-> ResultsOfLength m g s (m ()) -> ResultsOfLengthT m g s ()
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m ())
-> ResultsOfLength m g s (m ())
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 ()
effectsm () -> [m ()] -> NonEmpty (m ())
forall a. a -> [a] -> NonEmpty a
:|[])] ParseFailure Pos s
forall a. Monoid a => a
mempty
ResultList [ResultsOfLengthT m g s a]
rl ParseFailure Pos s
_failure -> (ResultsOfLengthT m g s a -> ResultListT m g s ())
-> [ResultsOfLengthT m g s a] -> ResultListT m g s ()
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)) =
(m a -> ResultListT m g s ())
-> NonEmpty (m a) -> ResultListT m g s ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') (m ()
effects m () -> m a -> m ()
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 :: 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) = ([(s, g (ResultListT m g s))]
-> ResultListT m g s (Either (ParseFailure Pos s) a))
-> ParserT m g s (Either (ParseFailure Pos s) 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))]
-> ResultListT m g s (Either (ParseFailure Pos s) a)
q
where q :: [(s, g (ResultListT m g s))]
-> ResultListT m g s (Either (ParseFailure Pos 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 Pos s
failure -> [ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)]
-> ParseFailure Pos s
-> ResultListT m g s (Either (ParseFailure Pos s) a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m (Either (ParseFailure Pos s) a))
-> ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT
(ResultsOfLength m g s (m (Either (ParseFailure Pos s) a))
-> ResultsOfLengthT m g s (Either (ParseFailure Pos s) a))
-> ResultsOfLength m g s (m (Either (ParseFailure Pos s) a))
-> ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m (Either (ParseFailure Pos s) a))
-> ResultsOfLength m g s (m (Either (ParseFailure Pos s) a))
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 (Either (ParseFailure Pos s) a -> m (Either (ParseFailure Pos s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseFailure Pos s -> Either (ParseFailure Pos s) a
forall a b. a -> Either a b
Left ParseFailure Pos s
failure) m (Either (ParseFailure Pos s) a)
-> [m (Either (ParseFailure Pos s) a)]
-> NonEmpty (m (Either (ParseFailure Pos s) a))
forall a. a -> [a] -> NonEmpty a
:| [])] ParseFailure Pos s
forall a. Monoid a => a
mempty
ResultList [ResultsOfLengthT m g s a]
rl ParseFailure Pos s
failure -> [ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)]
-> ParseFailure Pos s
-> ResultListT m g s (Either (ParseFailure Pos s) a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((m a -> m (Either (ParseFailure Pos s) a))
-> ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)
forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
mapResults ((a -> Either (ParseFailure Pos s) a)
-> m a -> m (Either (ParseFailure Pos s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either (ParseFailure Pos s) a
forall a b. b -> Either a b
Right) (ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s (Either (ParseFailure Pos s) a))
-> [ResultsOfLengthT m g s a]
-> [ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rl) ParseFailure Pos s
failure
admit :: 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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 Pos s
failure -> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [] ParseFailure Pos s
failure
ResultList [ResultsOfLengthT m g s (CommittedResults (ParserT m g s) a)]
rl ParseFailure Pos s
failure -> (ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)
-> ResultListT m g s a)
-> [ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)]
-> ResultListT m g s a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)
-> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Traversable m, Ord s) =>
ResultsOfLengthT m g s (Either (ParseFailure Pos s) r)
-> ResultListT m g s r
expose [ResultsOfLengthT m g s (Either (ParseFailure Pos s) a)]
[ResultsOfLengthT m g s (CommittedResults (ParserT m g s) a)]
rl ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
forall a. Semigroup a => a -> a -> a
<> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [] ParseFailure Pos s
failure
expose :: ResultsOfLengthT m g s (Either (ParseFailure Pos s) r)
-> ResultListT m g s r
expose (ResultsOfLengthT (ROL Int
len [(s, g (ResultListT m g s))]
t NonEmpty (m (Either (ParseFailure Pos s) r))
rs)) = case [m r] -> Maybe (NonEmpty (m r))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [m r]
successes of
Maybe (NonEmpty (m r))
Nothing -> [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [] ([ParseFailure Pos s] -> ParseFailure Pos s
forall a. Monoid a => [a] -> a
mconcat [ParseFailure Pos s]
failures)
Just NonEmpty (m r)
successes' -> [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r)
-> ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
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'] ([ParseFailure Pos s] -> ParseFailure Pos s
forall a. Monoid a => [a] -> a
mconcat [ParseFailure Pos s]
failures)
where ([ParseFailure Pos s]
failures, [m r]
successes) = [Either (ParseFailure Pos s) (m r)]
-> ([ParseFailure Pos s], [m r])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (m (Either (ParseFailure Pos s) r)
-> Either (ParseFailure Pos s) (m r)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (m (Either (ParseFailure Pos s) r)
-> Either (ParseFailure Pos s) (m r))
-> [m (Either (ParseFailure Pos s) r)]
-> [Either (ParseFailure Pos s) (m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m (Either (ParseFailure Pos s) r))
-> [m (Either (ParseFailure Pos s) r)]
forall a. NonEmpty a -> [a]
toList NonEmpty (m (Either (ParseFailure Pos s) r))
rs)
instance (Applicative m, MonoidNull s, Ord s) => LookAheadParsing (ParserT m g s) where
lookAhead :: ParserT m g s a -> ParserT m g s a
lookAhead (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))]
input-> [(s, g (ResultListT m g s))]
-> ResultListT m g s a -> ResultListT m g s a
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 Pos s
_) = ResultListT m g s r
rl
rewind [(s, g (ResultListT m g s))]
t (ResultList [ResultsOfLengthT m g s r]
rl ParseFailure Pos s
failure) =
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r)
-> ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall a b. (a -> b) -> a -> b
$ Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
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 (NonEmpty (m r) -> ResultsOfLength m g s (m r))
-> NonEmpty (m r) -> ResultsOfLength m g s (m r)
forall a b. (a -> b) -> a -> b
$ (NonEmpty (m r) -> NonEmpty (m r) -> NonEmpty (m r))
-> [NonEmpty (m r)] -> NonEmpty (m r)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 NonEmpty (m r) -> NonEmpty (m r) -> NonEmpty (m r)
forall a. Semigroup a => a -> a -> a
(<>) (ResultsOfLengthT m g s r -> NonEmpty (m r)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLengthT m g s r -> NonEmpty (m r)
results (ResultsOfLengthT m g s r -> NonEmpty (m r))
-> [ResultsOfLengthT m g s r] -> [NonEmpty (m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s r]
rl)] ParseFailure Pos 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s Char)
-> ParserT m g s Char
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 s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first -> Int
-> [(s, g (ResultListT m g s))] -> Char -> ResultListT m g s Char
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
_ -> [ResultsOfLengthT m g s Char]
-> ParseFailure Pos s -> ResultListT m g s Char
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s Char]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultListT m g s))]
rest) String
"Char.satisfy")
p [] = [ResultsOfLengthT m g s Char]
-> ParseFailure Pos s -> ResultListT m g s Char
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s Char]
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"Char.satisfy")
string :: String -> ParserT m g s String
string String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character") (s -> String) -> ParserT m g s s -> ParserT m g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (ParserT m g s)
-> ParserT m g s (ParserInput (ParserT m g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
text :: Text -> ParserT m g s Text
text Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character")) (s -> Text) -> ParserT m g s s -> ParserT m g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (ParserT m g s)
-> ParserT m g s (ParserInput (ParserT m g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)
instance (Applicative m, Eq (m ()), Ord s) => AmbiguousParsing (ParserT m g s) where
ambiguous :: 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) = ([(s, g (ResultListT m g s))] -> ResultListT m g s (Ambiguous a))
-> ParserT m g s (Ambiguous 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))] -> 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 Pos s
failure <- [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s (Ambiguous a)]
-> ParseFailure Pos s -> ResultListT m g s (Ambiguous a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s (Ambiguous a)
forall r.
ResultsOfLengthT m g s r -> ResultsOfLengthT m g s (Ambiguous r)
groupByLength (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s (Ambiguous a))
-> [ResultsOfLengthT m g s a]
-> [ResultsOfLengthT m g s (Ambiguous a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs) ParseFailure Pos s
failure
groupByLength :: ResultsOfLengthT m g s r -> ResultsOfLengthT m g s (Ambiguous r)
groupByLength :: 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)) =
ResultsOfLength m g s (m (Ambiguous r))
-> ResultsOfLengthT m g s (Ambiguous r)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m (Ambiguous r))
-> ResultsOfLength m g s (m (Ambiguous r))
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 (NonEmpty (m (Ambiguous r))
-> ResultsOfLength m g s (m (Ambiguous r)))
-> NonEmpty (m (Ambiguous r))
-> ResultsOfLength m g s (m (Ambiguous r))
forall a b. (a -> b) -> a -> b
$ (NonEmpty r -> Ambiguous r
forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty r -> Ambiguous r) -> m (NonEmpty r) -> m (Ambiguous r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (NonEmpty r) -> m (Ambiguous r))
-> NonEmpty (m (NonEmpty r)) -> NonEmpty (m (Ambiguous r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (NonEmpty r)] -> NonEmpty (m (NonEmpty r))
forall a. [a] -> NonEmpty a
fromList (NonEmpty (m r) -> m (NonEmpty r)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty (m r) -> m (NonEmpty r))
-> [NonEmpty (m r)] -> [m (NonEmpty r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m r -> m r -> Bool) -> NonEmpty (m r) -> [NonEmpty (m r)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (m () -> m () -> Bool
forall a. Eq a => a -> a -> Bool
(==) (m () -> m () -> Bool) -> (m r -> m ()) -> m r -> m r -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` m r -> m ()
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 :: ParserT Identity g s a
-> Parser g [(s, g (ResultListT Identity g s))] a
longest ParserT Identity g s a
p = ([(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a)
-> Parser g [(s, g (ResultListT Identity g s))] a
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 ParserT Identity g s a
-> [(s, g (ResultListT Identity g s))]
-> ResultListT Identity g s a
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 Pos
pos [FailureDescription s]
positive [FailureDescription s]
negative)
-> ParseFailure Pos [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
Backtrack.NoParse (Pos
-> [FailureDescription [(s, g (ResultListT Identity g s))]]
-> [FailureDescription [(s, g (ResultListT Identity g s))]]
-> ParseFailure Pos [(s, g (ResultListT Identity g s))]
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos ((FailureDescription s
-> FailureDescription [(s, g (ResultListT Identity g s))])
-> [FailureDescription s]
-> [FailureDescription [(s, g (ResultListT Identity g s))]]
forall a b. (a -> b) -> [a] -> [b]
map FailureDescription s
-> FailureDescription [(s, g (ResultListT Identity g s))]
forall a b. FailureDescription a -> FailureDescription [(a, b)]
message [FailureDescription s]
positive) ((FailureDescription s
-> FailureDescription [(s, g (ResultListT Identity g s))])
-> [FailureDescription s]
-> [FailureDescription [(s, g (ResultListT Identity g s))]]
forall a b. (a -> b) -> [a] -> [b]
map FailureDescription s
-> FailureDescription [(s, g (ResultListT Identity g s))]
forall a b. FailureDescription a -> FailureDescription [(a, b)]
message [FailureDescription s]
negative))
ResultList [ResultsOfLengthT Identity g s a]
rs ParseFailure Pos s
_ -> ResultsOfLengthT Identity g s a
-> Result g [(s, g (ResultListT Identity g s))] a
forall (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
ResultsOfLengthT Identity g s v
-> Result g [(s, g (ResultListT Identity g s))] v
parsed ([ResultsOfLengthT Identity g s a]
-> ResultsOfLengthT Identity g s a
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]
_))) = Int
-> v
-> [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] 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
message :: FailureDescription a -> FailureDescription [(a, b)]
message (StaticDescription String
msg) = String -> FailureDescription [(a, b)]
forall s. String -> FailureDescription s
StaticDescription String
msg
message (LiteralDescription a
s) = [(a, b)] -> FailureDescription [(a, b)]
forall s. s -> FailureDescription s
LiteralDescription [(a
s, String -> b
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 :: 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 = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> 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 Parser g [(s, g (ResultListT m g s))] a
-> [(s, g (ResultListT m g s))]
-> Result g [(s, g (ResultListT m g s))] a
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 -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
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 Pos
pos [FailureDescription [(s, g (ResultListT m g s))]]
positive [FailureDescription [(s, g (ResultListT m g s))]]
negative) ->
[ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos (((s, g (ResultListT m g s)) -> s
forall a b. (a, b) -> a
fst ((s, g (ResultListT m g s)) -> s)
-> ([(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s)))
-> [(s, g (ResultListT m g s))]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a. [a] -> a
head ([(s, g (ResultListT m g s))] -> s)
-> FailureDescription [(s, g (ResultListT m g s))]
-> FailureDescription s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (FailureDescription [(s, g (ResultListT m g s))]
-> FailureDescription s)
-> [FailureDescription [(s, g (ResultListT m g s))]]
-> [FailureDescription s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FailureDescription [(s, g (ResultListT m g s))]]
positive) (((s, g (ResultListT m g s)) -> s
forall a b. (a, b) -> a
fst ((s, g (ResultListT m g s)) -> s)
-> ([(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s)))
-> [(s, g (ResultListT m g s))]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> (s, g (ResultListT m g s))
forall a. [a] -> a
head ([(s, g (ResultListT m g s))] -> s)
-> FailureDescription [(s, g (ResultListT m g s))]
-> FailureDescription s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (FailureDescription [(s, g (ResultListT m g s))]
-> FailureDescription s)
-> [FailureDescription [(s, g (ResultListT m g s))]]
-> [FailureDescription s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FailureDescription [(s, g (ResultListT m g s))]]
negative))
terminalPEG :: (Applicative m, Monoid s, Ord s) => Backtrack.Parser g s a -> ParserT m g s a
terminalPEG :: Parser g s a -> ParserT m g s a
terminalPEG Parser g s a
p = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s 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))] -> ResultListT m g s a
q where
q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [] = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
forall a. Monoid a => a
mempty
of Backtrack.Parsed Int
l a
result s
_ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
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 Pos s
failure -> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty ParseFailure Pos 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 Parser g s a -> s -> Result g s a
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
_ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
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 (Int -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultListT m g s))]
rest) a
result
Backtrack.NoParse ParseFailure Pos s
failure -> [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty ParseFailure Pos s
failure
fromResultList :: (Functor m, Eq s, FactorialMonoid s) => ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList :: ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList (ResultList [] (ParseFailure Pos
pos [FailureDescription s]
positive [FailureDescription s]
negative)) = ParseFailure Pos s -> ParseResults s [(s, m r)]
forall a b. a -> Either a b
Left (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
- Pos
1) [FailureDescription s]
positive [FailureDescription s]
negative)
fromResultList (ResultList [ResultsOfLengthT m g s r]
rl ParseFailure Pos s
_failure) = [(s, m r)] -> ParseResults s [(s, m r)]
forall a b. b -> Either a b
Right ((ResultsOfLengthT m g s r -> [(s, m r)])
-> [ResultsOfLengthT m g s r] -> [(s, m r)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLengthT m g s r -> [(s, m r)]
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 (m r -> (a, m r)) -> [m r] -> [(a, m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m r) -> [m r]
forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
f (ResultsOfLengthT (ROL Int
_ [] NonEmpty (m r)
r)) = (,) a
forall a. Monoid a => a
mempty (m r -> (a, m r)) -> [m r] -> [(a, m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m r) -> [m r]
forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
{-# INLINABLE fromResultList #-}
instance Functor (ResultsOfLength m g s) where
fmap :: (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) = Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty b
-> ResultsOfLength m g s b
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 (a -> b) -> NonEmpty a -> NonEmpty b
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 :: (a -> b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
fmap a -> b
f (ResultsOfLengthT ResultsOfLength m g s (m a)
rol) = ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b)
-> ResultsOfLength m g s (m a) -> ResultsOfLength m g s (m b)
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 :: (a -> b) -> ResultListT m g s a -> ResultListT m g s b
fmap a -> b
f (ResultList [ResultsOfLengthT m g s a]
l ParseFailure Pos s
failure) = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((a -> b
f (a -> b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
l) ParseFailure Pos s
failure
{-# INLINE fmap #-}
instance (Applicative m, Ord s) => Applicative (ResultsOfLength m g s) where
pure :: a -> ResultsOfLength m g s a
pure = Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
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))]
forall a. Monoid a => a
mempty (NonEmpty a -> ResultsOfLength m g s a)
-> (a -> NonEmpty a) -> a -> ResultsOfLength m g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ROL Int
l1 [(s, g (ResultListT m g s))]
_ NonEmpty (a -> b)
fs <*> :: 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 = Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty b
-> ResultsOfLength m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) [(s, g (ResultListT m g s))]
t2 (NonEmpty (a -> b)
fs NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
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 :: a -> ResultsOfLengthT m g s a
pure = ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a)
-> (a -> ResultsOfLength m g s (m a))
-> a
-> ResultsOfLengthT m g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ResultsOfLength m g s (m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> ResultsOfLength m g s (m a))
-> (a -> m a) -> a -> ResultsOfLength m g s (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ResultsOfLengthT ResultsOfLength m g s (m (a -> b))
rol1 <*> :: ResultsOfLengthT m g s (a -> b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
<*> ResultsOfLengthT ResultsOfLength m g s (m a)
rol2 = ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT ((m (a -> b) -> m a -> m b)
-> ResultsOfLength m g s (m (a -> b))
-> ResultsOfLength m g s (m a)
-> ResultsOfLength m g s (m b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m (a -> b) -> m a -> m b
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 :: a -> ResultListT m g s a
pure a
a = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [a -> ResultsOfLengthT m g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a] ParseFailure Pos s
forall a. Monoid a => a
mempty
ResultList [ResultsOfLengthT m g s (a -> b)]
rl1 ParseFailure Pos s
f1 <*> :: ResultListT m g s (a -> b)
-> ResultListT m g s a -> ResultListT m g s b
<*> ResultList [ResultsOfLengthT m g s a]
rl2 ParseFailure Pos s
f2 = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList (ResultsOfLengthT m g s (a -> b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (ResultsOfLengthT m g s (a -> b)
-> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b)
-> [ResultsOfLengthT m g s (a -> b)]
-> [ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s (a -> b)]
rl1 [ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b]
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ResultsOfLengthT m g s a]
rl2) (ParseFailure Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)
instance (Applicative m, Ord s) => Alternative (ResultListT m g s) where
empty :: ResultListT m g s a
empty = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty ParseFailure Pos s
forall a. Monoid a => a
mempty
<|> :: ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s 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 :: 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 Pos s
f1) (ResultList [ResultsOfLengthT m g s (Ambiguous a)]
rl2 ParseFailure Pos s
f2) = [ResultsOfLengthT m g s (Ambiguous a)]
-> ParseFailure Pos s -> ResultListT m g s (Ambiguous a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ([ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
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 Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLengthT m g s (Ambiguous a)
rol1 ResultsOfLengthT m g s (Ambiguous a)
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLengthT m g s (Ambiguous a)
rol2 ResultsOfLengthT m g s (Ambiguous a)
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
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 = ResultsOfLength m g s (m (Ambiguous a))
-> ResultsOfLengthT m g s (Ambiguous a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m (Ambiguous a))
-> ResultsOfLength m g s (m (Ambiguous a))
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 (Ambiguous a))
-> ResultsOfLength m g s (m (Ambiguous a)))
-> NonEmpty (m (Ambiguous a))
-> ResultsOfLength m g s (m (Ambiguous a))
forall a b. (a -> b) -> a -> b
$ (m (Ambiguous a) -> m (Ambiguous a) -> m (Ambiguous a))
-> NonEmpty (m (Ambiguous a))
-> NonEmpty (m (Ambiguous a))
-> NonEmpty (m (Ambiguous a))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Ambiguous a -> Ambiguous a -> Ambiguous a)
-> m (Ambiguous a) -> m (Ambiguous a) -> m (Ambiguous a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Ambiguous a -> Ambiguous a -> Ambiguous a
forall a. Ambiguous a -> Ambiguous a -> Ambiguous a
collect) NonEmpty (m (Ambiguous a))
r1 NonEmpty (m (Ambiguous a))
r2) ResultsOfLengthT m g s (Ambiguous a)
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
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) = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty a
xs NonEmpty a -> NonEmpty a -> NonEmpty a
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 :: (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 Pos s
failure) = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((ResultsOfLengthT m g s a -> Maybe (ResultsOfLengthT m g s b))
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s b]
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 Pos 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)) =
ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength m g s (m b) -> ResultsOfLengthT m g s b)
-> (NonEmpty (m b) -> ResultsOfLength m g s (m b))
-> NonEmpty (m b)
-> ResultsOfLengthT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m b)
-> ResultsOfLength m g s (m b)
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 (NonEmpty (m b) -> ResultsOfLengthT m g s b)
-> Maybe (NonEmpty (m b)) -> Maybe (ResultsOfLengthT m g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m b] -> Maybe (NonEmpty (m b))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((m a -> Maybe (m b)) -> [m a] -> [m b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((a -> Maybe b) -> m a -> Maybe (m b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f) ([m a] -> [m b]) -> [m a] -> [m b]
forall a b. (a -> b) -> a -> b
$ NonEmpty (m a) -> [m a]
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 :: (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 Pos s
failure) = [ResultsOfLengthT (StateT state m) g s b]
-> ParseFailure Pos s -> ResultListT (StateT state m) g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ((ResultsOfLengthT (StateT state m) g s a
-> Maybe (ResultsOfLengthT (StateT state m) g s b))
-> [ResultsOfLengthT (StateT state m) g s a]
-> [ResultsOfLengthT (StateT state m) g s b]
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 Pos 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)) =
ResultsOfLength (StateT state m) g s (StateT state m b)
-> ResultsOfLengthT (StateT state m) g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (ResultsOfLength (StateT state m) g s (StateT state m b)
-> ResultsOfLengthT (StateT state m) g s b)
-> (NonEmpty (StateT state m b)
-> ResultsOfLength (StateT state m) g s (StateT state m b))
-> NonEmpty (StateT state m b)
-> ResultsOfLengthT (StateT state m) g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(s, g (ResultListT (StateT state m) g s))]
-> NonEmpty (StateT state m b)
-> ResultsOfLength (StateT state m) g s (StateT state m b)
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 (NonEmpty (StateT state m b)
-> ResultsOfLengthT (StateT state m) g s b)
-> Maybe (NonEmpty (StateT state m b))
-> Maybe (ResultsOfLengthT (StateT state m) g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT state m b] -> Maybe (NonEmpty (StateT state m b))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((StateT state m a -> Maybe (StateT state m b))
-> [StateT state m a] -> [StateT state m b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe StateT state m a -> Maybe (StateT state m b)
traverseWithMonoid ([StateT state m a] -> [StateT state m b])
-> [StateT state m a] -> [StateT state m b]
forall a b. (a -> b) -> a -> b
$ NonEmpty (StateT state m a) -> [StateT state m a]
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 = m b -> StateT state m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m b -> StateT state m b)
-> Maybe (m b) -> Maybe (StateT state m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Maybe b) -> m a -> Maybe (m b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f (StateT state m a -> state -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT state m a
m state
forall a. Monoid a => a
mempty)
instance Ord s => Semigroup (ResultListT m g s r) where
ResultList [ResultsOfLengthT m g s r]
rl1 ParseFailure Pos 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 Pos s
f2 = [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList ([ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
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 Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLengthT m g s r
rol1 ResultsOfLengthT m g s r
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLengthT m g s r
rol2 ResultsOfLengthT m g s r
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
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 = ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
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 NonEmpty (m r) -> NonEmpty (m r) -> NonEmpty (m r)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (m r)
r2)) ResultsOfLengthT m g s r
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
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 = [ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s r]
forall a. Monoid a => a
mempty ParseFailure Pos s
forall a. Monoid a => a
mempty
mappend :: ResultListT m g s r -> ResultListT m g s r -> ResultListT m g s r
mappend = ResultListT m g s r -> ResultListT m g s r -> ResultListT m g s r
forall a. Semigroup a => a -> a -> a
(<>)
instance FallibleResults (ResultListT m g) where
hasSuccess :: ResultListT m g s a -> Bool
hasSuccess (ResultList [] ParseFailure Pos s
_) = Bool
False
hasSuccess ResultListT m g s a
_ = Bool
True
failureOf :: ResultListT m g s a -> ParseFailure Pos s
failureOf (ResultList [ResultsOfLengthT m g s a]
_ ParseFailure Pos s
failure) = ParseFailure Pos s
failure
failWith :: ParseFailure Pos s -> ResultListT m g s a
failWith = [ResultsOfLengthT m g s a]
-> ParseFailure Pos s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
ResultList []