{-# LANGUAGE BangPatterns, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.SortedMemoizing.Transformer
       (FailureInfo(..), ResultListT(..), ParserT(..), (<<|>),
        lift, tmap, longest, peg, terminalPEG)
where

import Control.Applicative
import Control.Monad (MonadPlus(..), join, void)
import Data.Function (on)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.List (genericLength, nub)
import Data.List.NonEmpty (NonEmpty((:|)), groupBy, 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.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)

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(..), DeterministicParsing(..),
                          AmbiguousParsing(..), Ambiguous(Ambiguous),
                          TailsParsing(..), ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (FailureInfo(..), AmbiguousAlternative(..))
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack

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

-- | Parser for a context-free grammar with packrat-like sharing that carries a monadic computation as part of the
-- parse result.
newtype ParserT m g s r = Parser{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 -> FailureInfo s
resultFailures  :: !(FailureInfo s)}

singleResult :: Applicative m => 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 len :: Int
len rest :: [(s, g (ResultListT m g s))]
rest a :: r
a = [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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
:|[])] FailureInfo 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 f :: a -> b
f (Parser p :: [(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 => Applicative (ParserT m g s) where
   pure :: a -> ParserT m g s a
pure a :: 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 (\rest :: [(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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [(s, g (ResultListT m g s))]
rest a
a)
   Parser p :: [(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 q :: [(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 rest :: [(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 results :: [ResultsOfLengthT m g s (a -> b)]
results failure :: FailureInfo s
failure -> [ResultsOfLengthT m g s b] -> FailureInfo s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s b]
forall a. Monoid a => a
mempty FailureInfo 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 l :: Int
l rest' :: [(s, g (ResultListT m g s))]
rest' fs :: 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' l :: Int
l (ResultList rs :: [ResultsOfLengthT m g s a]
rs failure :: FailureInfo s
failure) f :: m (a -> r)
f = [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo s
failure
      adjust :: Int
-> m (a -> r)
-> ResultsOfLengthT m g s a
-> ResultsOfLengthT m g s r
adjust l :: Int
l f :: m (a -> r)
f (ResultsOfLengthT (ROL l' :: Int
l' rest' :: [(s, g (ResultListT m g s))]
rest' as :: 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 => 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 (\rest :: [(s, g (ResultListT m g s))]
rest-> [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (FailureInfo s -> ResultListT m g s a)
-> FailureInfo s -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [])
   Parser p :: [(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 q :: [(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 rest :: [(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 (Monad m, Traversable m) => 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 p :: [(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
>>= f :: 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 rest :: [(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 results :: [ResultsOfLengthT m g s a]
results failure :: FailureInfo s
failure -> [ResultsOfLengthT m g s b] -> FailureInfo s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s b]
forall a. Monoid a => a
mempty FailureInfo 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 l :: Int
l rest' :: [(s, g (ResultListT m g s))]
rest' rs :: 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' l :: Int
l (ResultList rs :: [ResultsOfLengthT m g s r]
rs failure :: FailureInfo s
failure) = [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo s
failure
      adjust :: Int -> ResultsOfLengthT m g s r -> ResultsOfLengthT m g s r
adjust l :: Int
l (ResultsOfLengthT (ROL l' :: Int
l' rest' :: [(s, g (ResultListT m g s))]
rest' rs :: 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 :: 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 (\rest :: [(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 :: m (ResultListT m g s a)
m = [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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 -> FailureInfo s)
-> m (ResultListT m g s a) -> FailureInfo s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultListT m g s a -> FailureInfo s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultListT m g s r -> FailureInfo s
resultFailures m (ResultListT m g s a)
m)
      rejoinResultsOfLengthT :: m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
rejoinResultsOfLengthT m :: 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)

instance (Foldable m, Monad m, Traversable m) => 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 a parse-free computation into the parser.
lift :: m a -> ParserT m g s a
lift :: m a -> ParserT m g s a
lift m :: 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 (\rest :: [(s, g (ResultListT m g s))]
rest-> [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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 0 [(s, g (ResultListT m g s))]
rest (m a
mm a -> [m a] -> NonEmpty (m a)
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty)

-- | Modify the computation carried by the parser.
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 f :: m a -> m b
f (Parser p :: [(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)

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 f :: m a -> m b
f (ResultList successes :: [ResultsOfLengthT m g s a]
successes failures :: FailureInfo s
failures) = [ResultsOfLengthT m g s b] -> FailureInfo s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo s
failures

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 f :: m a -> m b
f (ResultsOfLengthT rol :: 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) => 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) => 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 = (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. Monoid a => a -> a -> a
mappend

-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left
-- recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (Applicative m, LeftReductive s, FactorialMonoid s) => MultiParsing (ParserT m g s) where
   type GrammarConstraint (ParserT m g s) g' = (g ~ g', Rank2.Functor g)
   type ResultFunctor (ParserT m g s) = Compose (Compose (ParseResults s) []) m
   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
   parsePrefix :: g (ParserT m g s)
-> s -> g (Compose (ResultFunctor (ParserT m g s)) ((,) s))
parsePrefix g :: g (ParserT m g s)
g input :: 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 (Either (ParseFailure s)) []) m (s, a)
-> Compose
     (Compose (Compose (Either (ParseFailure s)) []) m) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Compose (Either (ParseFailure s)) []) m (s, a)
 -> Compose
      (Compose (Compose (Either (ParseFailure s)) []) m) ((,) s) a)
-> (ResultListT m g s a
    -> Compose (Compose (Either (ParseFailure s)) []) m (s, a))
-> ResultListT m g s a
-> Compose
     (Compose (Compose (Either (ParseFailure s)) []) m) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Either (ParseFailure s)) [] (m (s, a))
-> Compose (Compose (Either (ParseFailure 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 s)) [] (m (s, a))
 -> Compose (Compose (Either (ParseFailure s)) []) m (s, a))
-> (ResultListT m g s a
    -> Compose (Either (ParseFailure s)) [] (m (s, a)))
-> ResultListT m g s a
-> Compose (Compose (Either (ParseFailure s)) []) m (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [m (s, a)]
-> Compose (Either (ParseFailure s)) [] (m (s, a))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [m (s, a)]
 -> Compose (Either (ParseFailure s)) [] (m (s, a)))
-> (ResultListT m g s a -> Either (ParseFailure s) [m (s, a)])
-> ResultListT m g s a
-> Compose (Either (ParseFailure s)) [] (m (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(s, m a)] -> [m (s, a)])
-> Either (ParseFailure s) [(s, m a)]
-> Either (ParseFailure 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 s) [(s, m a)]
 -> Either (ParseFailure s) [m (s, a)])
-> (ResultListT m g s a -> Either (ParseFailure s) [(s, m a)])
-> ResultListT m g s a
-> Either (ParseFailure s) [m (s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultListT m g s a -> Either (ParseFailure s) [(s, m a)]
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
s -> ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList s
input)
                                    ((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 :: (ParserInput (ParserT m g s) ~ s, Rank2.Functor g, Eq s, FactorialMonoid s) =>
                    g (ParserT m g s) -> s -> g (Compose (Compose (ParseResults s) []) m)
   parseComplete :: g (ParserT m g s)
-> s -> g (Compose (Compose (ParseResults s) []) m)
parseComplete g :: g (ParserT m g s)
g input :: 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 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 s) [(s, m a)]
 -> Compose (ParseResults s) [] (s, m a))
-> (ResultListT m g s a -> Either (ParseFailure 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
. s -> ResultListT m g s a -> Either (ParseFailure s) [(s, m a)]
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
s -> ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList s
input)
                              ((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)))]
 -> [(s, g (ResultListT m g s))])
-> [(ParserInput (ParserT m g s),
     g (GrammarFunctor (ParserT 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 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, Eq s, LeftReductive s, FactorialMonoid s, Rank2.Functor g) =>
         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 s :: ParserInput (ParserT m g s)
s = Compose (Either (ParseFailure s)) [] (m (s, a))
-> Compose (Compose (Either (ParseFailure 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 s)) [] (m (s, a))
 -> Compose (Compose (Either (ParseFailure s)) []) m (s, a))
-> (ResultListT m g s a
    -> Compose (Either (ParseFailure s)) [] (m (s, a)))
-> ResultListT m g s a
-> Compose (Compose (Either (ParseFailure s)) []) m (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [m (s, a)]
-> Compose (Either (ParseFailure s)) [] (m (s, a))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [m (s, a)]
 -> Compose (Either (ParseFailure s)) [] (m (s, a)))
-> (ResultListT m g s a -> Either (ParseFailure s) [m (s, a)])
-> ResultListT m g s a
-> Compose (Either (ParseFailure s)) [] (m (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(s, m a)] -> [m (s, a)])
-> Either (ParseFailure s) [(s, m a)]
-> Either (ParseFailure 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 s) [(s, m a)]
 -> Either (ParseFailure s) [m (s, a)])
-> (ResultListT m g s a -> Either (ParseFailure s) [(s, m a)])
-> ResultListT m g s a
-> Either (ParseFailure s) [m (s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultListT m g s a -> Either (ParseFailure s) [(s, m a)]
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
(Functor m, Eq s, FactorialMonoid s) =>
s -> ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList s
ParserInput (ParserT m g s)
s
   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 f :: 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 ((_, d :: g (ResultListT m g s)
d) : _) = g (ResultListT m g s) -> ResultListT m g s a
f g (ResultListT m g s)
d
      p _ = [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "NonTerminal at endOfInput"])
   {-# INLINE nonTerminal #-}

instance (Applicative m, Eq 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 :: g (ParserT m g s)
g input :: 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 parsedTail :: [(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) => 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, 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@((s :: r
s, _):_) = Int -> [(r, g (ResultListT m g r))] -> r -> ResultListT m g r r
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 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) =>
[(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@((s :: r
s, _):t :: [(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 (first :: r
first, _) -> Int -> [(r, g (ResultListT m g r))] -> r -> ResultListT m g r r
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 1 [(r, g (ResultListT m g r))]
t r
first
                                   _ -> [ResultsOfLengthT m g r r] -> FailureInfo r -> ResultListT m g r r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g r r]
forall a. Monoid a => a
mempty (Int -> [Expected r] -> FailureInfo r
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(r, g (ResultListT m g r))] -> Int
forall i a. Num i => [a] -> i
genericLength [(r, g (ResultListT m g r))]
rest) [String -> Expected r
forall s. String -> Expected s
Expected "anyToken"])
            p [] = [ResultsOfLengthT m g r r] -> FailureInfo r -> ResultListT m g r r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g r r]
forall a. Monoid a => a
mempty (Int -> [Expected r] -> FailureInfo r
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected r
forall s. String -> Expected s
Expected "anyToken"])
   satisfy :: (ParserInput (ParserT m g s) -> Bool)
-> ParserT m g s (ParserInput (ParserT m g s))
satisfy predicate :: 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
s, _):t :: [(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 (first :: s
first, _) | 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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 1 [(s, g (ResultListT m g s))]
t s
first
                  _ -> [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
            p [] = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
   scan :: state
-> (state -> ParserInput (ParserT m g s) -> Maybe state)
-> ParserT m g s (ParserInput (ParserT m g s))
scan s0 :: state
s0 f :: 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 s :: state
s rest :: [(s, g (ResultListT m g s))]
rest@((i :: s
i, _) : _) = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 (prefix :: s
prefix, _, _) = 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 _ [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 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 predicate :: 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
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 =>
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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [] s
forall a. Monoid a => a
mempty
   take :: Int -> ParserT m g s (ParserInput (ParserT m g s))
take 0 = ParserT m g s (ParserInput (ParserT m g s))
forall a. Monoid a => a
mempty
   take n :: 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
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 =>
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 rest :: [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected (String -> Expected s) -> String -> Expected s
forall a b. (a -> b) -> a -> b
$ "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 predicate :: 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
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
> 0 =
                    Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 rest :: [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "takeWhile1"])
   string :: ParserInput (ParserT m g s)
-> ParserT m g s (ParserInput (ParserT m g s))
string s :: 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
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 =>
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 rest :: [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [s -> Expected s
forall s. s -> Expected s
ExpectedInput 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 predicate :: 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
s, _):_)
               | Just (first :: s
first, _) <- 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 ()]
-> FailureInfo s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfy"])
            p rest :: [(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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [(s, g (ResultListT m g s))]
rest ()
   {-# INLINABLE string #-}

instance (Applicative m, Show s, TextualMonoid s) => InputCharParsing (ParserT m g s) where
   satisfyCharInput :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
satisfyCharInput predicate :: 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
s, _):t :: [(s, g (ResultListT m g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: 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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 1 [(s, g (ResultListT m g s))]
t (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s)
                  _ -> [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
            p [] = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
   scanChars :: state
-> (state -> Char -> Maybe state)
-> ParserT m g s (ParserInput (ParserT m g s))
scanChars s0 :: state
s0 f :: 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 s :: state
s rest :: [(s, g (ResultListT m g s))]
rest@((i :: s
i, _) : _) = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 (prefix :: s
prefix, _, _) = 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 _ [] = Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [] s
forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile predicate :: 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
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 =>
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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [] s
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> ParserT m g s (ParserInput (ParserT m g s))
takeCharsWhile1 predicate :: 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
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
> 0 =
                    Int -> [(s, g (ResultListT m g s))] -> s -> ResultListT m g s s
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 rest :: [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s s] -> FailureInfo s -> ResultListT m g s s
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "takeCharsWhile1"])
   notSatisfyChar :: (Char -> Bool) -> ParserT m g s ()
notSatisfyChar predicate :: 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
s, _):_)
               | Just first :: 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 ()]
-> FailureInfo s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfyChar"])
            p rest :: [(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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [(s, g (ResultListT m g s))]
rest ()

instance (Applicative m, LeftReductive s, FactorialMonoid 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 p :: [(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
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 input :: a
input (ResultList rl :: [ResultsOfLengthT m g s b]
rl failure :: FailureInfo s
failure) = [ResultsOfLengthT m g s (a, b)]
-> FailureInfo s -> ResultListT m g s (a, b)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo s
failure
               where add1 :: ResultsOfLengthT m g s b -> ResultsOfLengthT m g s (a, b)
add1 (ResultsOfLengthT (ROL l :: Int
l t :: [(s, g (ResultListT m g s))]
t rs :: 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) => Parsing (ParserT m g s) where
   try :: ParserT m g s a -> ParserT m g s a
try (Parser p :: [(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 rest :: [(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 rl :: [ResultsOfLengthT m g s a]
rl (FailureInfo _pos :: Int
_pos _msgs :: [Expected s]
_msgs)) =
                        [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
rl (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [])
   Parser p :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <?> :: ParserT m g s a -> String -> ParserT m g s a
<?> msg :: 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 rest :: [(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 [] (FailureInfo pos :: Int
pos msgs :: [Expected s]
msgs)) =
                        [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [] (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected s] -> FailureInfo s) -> [Expected s] -> FailureInfo s
forall a b. (a -> b) -> a -> b
$ if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest then [String -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
msgs)
                     replaceFailure rl :: ResultListT m g s a
rl = ResultListT m g s a
rl
   notFollowedBy :: ParserT m g s a -> ParserT m g s ()
notFollowedBy (Parser p :: [(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 (\input :: [(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 =>
[(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 t :: [(s, g (ResultListT m g s))]
t (ResultList [] _) = Int -> [(s, g (ResultListT m g s))] -> () -> ResultListT m g s ()
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [(s, g (ResultListT m g s))]
t ()
            rewind t :: [(s, g (ResultListT m g s))]
t ResultList{} = [ResultsOfLengthT m g s ()]
-> FailureInfo s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected "notFollowedBy"])
   skipMany :: ParserT m g s a -> ParserT m g s ()
skipMany p :: 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 msg :: 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 (\t :: [(s, g (ResultListT m g s))]
t-> [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (FailureInfo s -> ResultListT m g s a)
-> FailureInfo s -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected 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) =>
[(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
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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [(s, g (ResultListT m g s))]
rest ()
               | Bool
otherwise = [ResultsOfLengthT m g s ()]
-> FailureInfo s -> ResultListT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "end of input"])
            f [] = Int -> [(s, g (ResultListT m g s))] -> () -> ResultListT m g s ()
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 0 [] ()

instance (Applicative m, MonoidNull s) => DeterministicParsing (ParserT m g s) where
   Parser p :: [(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 q :: [(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 rest :: [(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 [] _failure :: FailureInfo 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
                  rl :: ResultListT m g s a
rl -> ResultListT m g s a
rl
   takeSome :: ParserT m g s a -> ParserT m g s [a]
takeSome p :: 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 p :: [(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 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 acc :: m ([a] -> [a])
acc rest :: [(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 [] _failure :: FailureInfo s
_failure
                              -> [ResultsOfLengthT m g s [a]]
-> FailureInfo s -> ResultListT m g s [a]
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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
:| [])] FailureInfo s
forall a. Monoid a => a
mempty
                           ResultList rl :: [ResultsOfLengthT m g s a]
rl _ -> (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 len' :: Int
len' rest' :: [(s, g (ResultListT m g s))]
rest' results :: 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 (\r :: 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 p :: [(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 -> [(s, g (ResultListT m g s))] -> ResultListT m g s ()
q 0) where
      q :: Int -> [(s, g (ResultListT m g s))] -> ResultListT m g s ()
q !Int
len rest :: [(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 [] _failure :: FailureInfo s
_failure -> Int -> [(s, g (ResultListT m g s))] -> () -> ResultListT m g s ()
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
len [(s, g (ResultListT m g s))]
rest ()
                       ResultList rl :: [ResultsOfLengthT m g s a]
rl _failure :: FailureInfo 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 len' :: Int
len' rest' :: [(s, g (ResultListT m g s))]
rest' _)) = Int -> [(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') [(s, g (ResultListT m g s))]
rest'

instance (Applicative m, MonoidNull s) => LookAheadParsing (ParserT m g s) where
   lookAhead :: ParserT m g s a -> ParserT m g s a
lookAhead (Parser p :: [(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 (\input :: [(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 _ rl :: ResultListT m g s r
rl@(ResultList [] _) = ResultListT m g s r
rl
            rewind t :: [(s, g (ResultListT m g s))]
t (ResultList rl :: [ResultsOfLengthT m g s r]
rl failure :: FailureInfo s
failure) =
               [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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 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)] FailureInfo s
failure
            results :: ResultsOfLengthT m g s r -> NonEmpty (m r)
results (ResultsOfLengthT (ROL _ _ r :: NonEmpty (m r)
r)) = NonEmpty (m r)
r

instance (Applicative m, Show s, TextualMonoid s) => CharParsing (ParserT m g s) where
   satisfy :: (Char -> Bool) -> ParserT m g s Char
satisfy predicate :: 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
s, _):t :: [(s, g (ResultListT m g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: 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 =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult 1 [(s, g (ResultListT m g s))]
t Char
first
                  _ -> [ResultsOfLengthT m g s Char]
-> FailureInfo s -> ResultListT m g s Char
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s Char]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultListT m g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultListT m g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
            p [] = [ResultsOfLengthT m g s Char]
-> FailureInfo s -> ResultListT m g s Char
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s Char]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
   string :: String -> ParserT m g s String
string s :: 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 "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 t :: 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 "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 ())) => AmbiguousParsing (ParserT m g s) where
   ambiguous :: ParserT m g s a -> ParserT m g s (Ambiguous a)
ambiguous (Parser p :: [(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 rest :: [(s, g (ResultListT m g s))]
rest | ResultList rs :: [ResultsOfLengthT m g s a]
rs failure :: FailureInfo 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)]
-> FailureInfo s -> ResultListT m g s (Ambiguous a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo 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 l :: Int
l rest :: [(s, g (ResultListT m g s))]
rest rs :: 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))

-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
-- of input tails, opposite of 'peg'
longest :: ParserT Identity g s a -> Backtrack.Parser g [(s, g (ResultListT Identity g s))] a
longest :: ParserT Identity g s a
-> Parser g [(s, g (ResultListT Identity g s))] a
longest p :: 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 rest :: [(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 [] (FailureInfo pos :: Int
pos expected :: [Expected s]
expected) -> FailureInfo [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
Backtrack.NoParse (Int
-> [Expected [(s, g (ResultListT Identity g s))]]
-> FailureInfo [(s, g (ResultListT Identity g s))]
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected [(s, g (ResultListT Identity g s))]]
 -> FailureInfo [(s, g (ResultListT Identity g s))])
-> [Expected [(s, g (ResultListT Identity g s))]]
-> FailureInfo [(s, g (ResultListT Identity g s))]
forall a b. (a -> b) -> a -> b
$ (Expected s -> Expected [(s, g (ResultListT Identity g s))])
-> [Expected s] -> [Expected [(s, g (ResultListT Identity g s))]]
forall a b. (a -> b) -> [a] -> [b]
map Expected s -> Expected [(s, g (ResultListT Identity g s))]
forall a b. Expected a -> Expected [(a, b)]
message [Expected s]
expected)
               ResultList rs :: [ResultsOfLengthT Identity g s a]
rs _ -> 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 l :: Int
l s :: [(s, g (ResultListT Identity g s))]
s (Identity r :: v
r:|_))) = 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 :: Expected a -> Expected [(a, b)]
message (Expected msg :: String
msg) = String -> Expected [(a, b)]
forall s. String -> Expected s
Expected String
msg
   message (ExpectedInput s :: a
s) = [(a, b)] -> Expected [(a, b)]
forall s. s -> Expected s
ExpectedInput [(a
s, String -> b
forall a. HasCallStack => String -> a
error "longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
peg :: Applicative m => 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 p :: 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 rest :: [(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 l :: Int
l result :: a
result suffix :: [(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 =>
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 (FailureInfo pos :: Int
pos expected :: [Expected [(s, g (ResultListT m g s))]]
expected) ->
                  [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
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)
-> Expected [(s, g (ResultListT m g s))] -> Expected s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Expected [(s, g (ResultListT m g s))] -> Expected s)
-> [Expected [(s, g (ResultListT m g s))]] -> [Expected s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expected [(s, g (ResultListT m g s))]]
expected))

-- | Turns a backtracking PEG parser into a context-free parser
terminalPEG :: (Applicative m, Monoid s) => Backtrack.Parser g s a -> ParserT m g s a
terminalPEG :: Parser g s a -> ParserT m g s a
terminalPEG p :: 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 l :: Int
l result :: a
result _ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l [] a
result
               Backtrack.NoParse failure :: FailureInfo s
failure -> [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty FailureInfo s
failure
   q rest :: [(s, g (ResultListT m g s))]
rest@((s :: s
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 l :: Int
l result :: a
result _ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 failure :: FailureInfo s
failure -> [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty FailureInfo s
failure

fromResultList :: (Functor m, Eq s, FactorialMonoid s) => s -> ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList :: s -> ResultListT m g s r -> ParseResults s [(s, m r)]
fromResultList s :: s
s (ResultList [] (FailureInfo pos :: Int
pos msgs :: [Expected s]
msgs)) =
   ParseFailure s -> ParseResults s [(s, m r)]
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList _ (ResultList rl :: [ResultsOfLengthT m g s r]
rl _failure :: FailureInfo 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 _ ((s :: a
s, _):_) r :: 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 _ [] r :: 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 f :: a -> b
f (ROL l :: Int
l t :: [(s, g (ResultListT m g s))]
t a :: 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 f :: a -> b
f (ResultsOfLengthT rol :: 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 f :: a -> b
f (ResultList l :: [ResultsOfLengthT m g s a]
l failure :: FailureInfo s
failure) = [ResultsOfLengthT m g s b] -> FailureInfo s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) FailureInfo s
failure
   {-# INLINE fmap #-}

instance Applicative m => 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 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 l1 :: Int
l1 _ fs :: NonEmpty (a -> b)
fs <*> :: ResultsOfLength m g s (a -> b)
-> ResultsOfLength m g s a -> ResultsOfLength m g s b
<*> ROL l2 :: Int
l2 t2 :: [(s, g (ResultListT m g s))]
t2 xs :: 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 => 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 rol1 :: 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 rol2 :: 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 => Applicative (ResultListT m g s) where
   pure :: a -> ResultListT m g s a
pure a :: a
a = [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [a -> ResultsOfLengthT m g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a] FailureInfo s
forall a. Monoid a => a
mempty
   ResultList rl1 :: [ResultsOfLengthT m g s (a -> b)]
rl1 f1 :: FailureInfo s
f1 <*> :: ResultListT m g s (a -> b)
-> ResultListT m g s a -> ResultListT m g s b
<*> ResultList rl2 :: [ResultsOfLengthT m g s a]
rl2 f2 :: FailureInfo s
f2 = [ResultsOfLengthT m g s b] -> FailureInfo s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) (FailureInfo s
f1 FailureInfo s -> FailureInfo s -> FailureInfo s
forall a. Semigroup a => a -> a -> a
<> FailureInfo s
f2)

instance Applicative m => Alternative (ResultListT m g s) where
   empty :: ResultListT m g s a
empty = [ResultsOfLengthT m g s a] -> FailureInfo s -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s a]
forall a. Monoid a => a
mempty FailureInfo 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 => 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 rl1 :: [ResultsOfLengthT m g s (Ambiguous a)]
rl1 f1 :: FailureInfo s
f1) (ResultList rl2 :: [ResultsOfLengthT m g s (Ambiguous a)]
rl2 f2 :: FailureInfo s
f2) = [ResultsOfLengthT m g s (Ambiguous a)]
-> FailureInfo s -> ResultListT m g s (Ambiguous a)
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) (FailureInfo s
f1 FailureInfo s -> FailureInfo s -> FailureInfo s
forall a. Semigroup a => a -> a -> a
<> FailureInfo s
f2)
      where merge :: [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
-> [ResultsOfLengthT m g s (Ambiguous a)]
merge [] rl :: [ResultsOfLengthT m g s (Ambiguous a)]
rl = [ResultsOfLengthT m g s (Ambiguous a)]
rl
            merge rl :: [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 l1 :: Int
l1 s1 :: [(s, g (ResultListT m g s))]
s1 r1 :: NonEmpty (m (Ambiguous a))
r1)) : rest1 :: [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 l2 :: Int
l2 _ r2 :: NonEmpty (m (Ambiguous a))
r2)) : rest2 :: [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 xs :: NonEmpty a
xs) (Ambiguous ys :: 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 Semigroup (ResultListT m g s r) where
   ResultList rl1 :: [ResultsOfLengthT m g s r]
rl1 f1 :: FailureInfo s
f1 <> :: ResultListT m g s r -> ResultListT m g s r -> ResultListT m g s r
<> ResultList rl2 :: [ResultsOfLengthT m g s r]
rl2 f2 :: FailureInfo s
f2 = [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo 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) (FailureInfo s
f1 FailureInfo s -> FailureInfo s -> FailureInfo s
forall a. Semigroup a => a -> a -> a
<> FailureInfo s
f2)
      where merge :: [ResultsOfLengthT m g s r]
-> [ResultsOfLengthT m g s r] -> [ResultsOfLengthT m g s r]
merge [] rl :: [ResultsOfLengthT m g s r]
rl = [ResultsOfLengthT m g s r]
rl
            merge rl :: [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 l1 :: Int
l1 s1 :: [(s, g (ResultListT m g s))]
s1 r1 :: NonEmpty (m r)
r1)) : rest1 :: [ResultsOfLengthT m g s r]
rest1)
                 rl2' :: [ResultsOfLengthT m g s r]
rl2'@(rol2 :: ResultsOfLengthT m g s r
rol2@(ResultsOfLengthT (ROL l2 :: Int
l2 _ r2 :: NonEmpty (m r)
r2)) : rest2 :: [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 Monoid (ResultListT m g s r) where
   mempty :: ResultListT m g s r
mempty = [ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r] -> FailureInfo s -> ResultListT m g s r
ResultList [ResultsOfLengthT m g s r]
forall a. Monoid a => a
mempty FailureInfo 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
(<>)