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

import Control.Applicative
import Control.Monad (MonadFail(fail), MonadPlus(..), join, void)
import qualified Control.Monad.Trans.Class as Trans (lift)
import Control.Monad.Trans.State.Strict (StateT, evalStateT)
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, nonEmpty, fromList, toList)
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid, splitPrimePrefix)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)
import Witherable (Filterable(mapMaybe))
import Debug.Trace (trace)

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

import qualified Rank2

import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
                          ConsumedInputParsing(..), DeterministicParsing(..),
                          AmbiguousParsing(..), Ambiguous(Ambiguous),
                          TailsParsing(..), ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (FailureInfo(..), FallibleResults(..), AmbiguousAlternative(..), TraceableParsing(..))
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 Int
len [(s, g (ResultListT m g s))]
rest 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 a -> b
f (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((a -> b) -> ResultListT m g s a -> ResultListT m g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)
   {-# INLINE fmap #-}

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

instance Applicative m => Alternative (ParserT m g s) where
   empty :: ParserT m g s a
empty = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> [ResultsOfLengthT m g s a] -> 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 [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <|> :: ParserT m g s a -> ParserT m g s a -> ParserT m g s a
<|> Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
r where
      r :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
r [(s, g (ResultListT m g s))]
rest = [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest ResultListT m g s a -> ResultListT m g s a -> ResultListT m g s a
forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest
   {-# INLINE (<|>) #-}
   {-# INLINABLE empty #-}

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

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

instance (Monad m, Traversable m) => Monad (ParserT m g s) where
   return :: a -> ParserT m g s a
return = a -> ParserT m g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   >> :: ParserT m g s a -> ParserT m g s b -> ParserT m g s b
(>>) = ParserT m g s a -> ParserT m g s b -> ParserT m g s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
   Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p >>= :: ParserT m g s a -> (a -> ParserT m g s b) -> ParserT m g s b
>>= a -> ParserT m g s b
f = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s b
q where
      q :: [(s, g (ResultListT m g s))] -> ResultListT m g s b
q [(s, g (ResultListT m g s))]
rest = case [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest
               of ResultList [ResultsOfLengthT m g s a]
results 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 Int
l [(s, g (ResultListT m g s))]
rest' NonEmpty (m a)
rs)) = (m a -> ResultListT m g s b)
-> NonEmpty (m a) -> ResultListT m g s b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> ResultListT m g s b -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
Int -> ResultListT m g s r -> ResultListT m g s r
continue' Int
l (ResultListT m g s b -> ResultListT m g s b)
-> (m a -> ResultListT m g s b) -> m a -> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParserT m g s b
 -> [(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> [(s, g (ResultListT m g s))]
-> ParserT m g s b
-> ResultListT m g s b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserT m g s b
-> [(s, g (ResultListT m g s))] -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser [(s, g (ResultListT m g s))]
rest' (ParserT m g s b -> ResultListT m g s b)
-> (m a -> ParserT m g s b) -> m a -> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (ParserT m g s b) -> ParserT m g s b
forall a. m (ParserT m g s a) -> ParserT m g s a
rejoin (m (ParserT m g s b) -> ParserT m g s b)
-> (m a -> m (ParserT m g s b)) -> m a -> ParserT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ParserT m g s b) -> m a -> m (ParserT m g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ParserT m g s b
f) NonEmpty (m a)
rs
      continue' :: Int -> ResultListT m g s r -> ResultListT m g s r
continue' Int
l (ResultList [ResultsOfLengthT m g s r]
rs 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 Int
l (ResultsOfLengthT (ROL Int
l' [(s, g (ResultListT m g s))]
rest' NonEmpty (m r)
rs)) = ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m r)
-> ResultsOfLength m g s (m r)
forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultListT m g s))]
rest' NonEmpty (m r)
rs)
      rejoin :: forall a. m (ParserT m g s a) -> ParserT m g s a
      rejoinResults :: forall a. m (ResultListT m g s a) -> ResultListT m g s a
      rejoinResultsOfLengthT :: forall a. m (ResultsOfLengthT m g s a) -> ResultsOfLengthT m g s a
      rejoin :: m (ParserT m g s a) -> ParserT m g s a
rejoin m (ParserT m g s a)
m = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> m (ResultListT m g s a) -> ResultListT m g s a
forall a. m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults (m (ResultListT m g s a) -> ResultListT m g s a)
-> m (ResultListT m g s a) -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ (ParserT m g s a
 -> [(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ParserT m g s a
-> ResultListT m g s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser [(s, g (ResultListT m g s))]
rest (ParserT m g s a -> ResultListT m g s a)
-> m (ParserT m g s a) -> m (ResultListT m g s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ParserT m g s a)
m)
      rejoinResults :: m (ResultListT m g s a) -> ResultListT m g s a
rejoinResults m (ResultListT m g s a)
m = [ResultsOfLengthT m g s a] -> 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 (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 (Monad m, Traversable m) => MonadFail (ParserT m g s) where
   fail :: String -> ParserT m g s a
fail String
msg = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p
      where p :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest = [ResultsOfLengthT m g s a] -> 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 ([(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
msg])

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 a
m = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
rest-> [ResultsOfLengthT m g s a] -> 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
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)

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

-- | Transform 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 m a -> m b
f (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s b)
-> ParserT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser ((m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
forall (m :: * -> *) a b (g :: (* -> *) -> *) s.
(m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList m a -> m b
f (ResultListT m g s a -> ResultListT m g s b)
-> ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))]
-> ResultListT m g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultListT m g s))] -> ResultListT m g s a
p)

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

mapResultList :: (m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList :: (m a -> m b) -> ResultListT m g s a -> ResultListT m g s b
mapResultList m a -> m b
f (ResultList [ResultsOfLengthT m g s a]
successes 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

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

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

instance (Applicative m, Semigroup x) => 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 that carries an applicative computation. Can be wrapped with
-- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (Applicative m, LeftReductive s, FactorialMonoid s) => 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 (ParserT m g s)
g s
input = (forall a.
 ResultListT m g s a
 -> Compose (Compose (Compose (ParseResults s) []) m) ((,) s) a)
-> g (ResultListT m g s)
-> g (Compose (Compose (Compose (ParseResults s) []) m) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (Compose (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 (ParserT m g s)
g s
input = (forall a.
 ResultListT m g s a -> Compose (Compose (ParseResults s) []) m a)
-> g (ResultListT m g s)
-> g (Compose (Compose (ParseResults s) []) m)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (ParseResults s) [] (m a)
-> Compose (Compose (ParseResults s) []) m a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (ParseResults s) [] (m a)
 -> Compose (Compose (ParseResults s) []) m a)
-> (ResultListT m g s a -> Compose (ParseResults s) [] (m a))
-> ResultListT m g s a
-> Compose (Compose (ParseResults s) []) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, m a) -> m a)
-> Compose (ParseResults s) [] (s, m a)
-> Compose (ParseResults s) [] (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, m a) -> m a
forall a b. (a, b) -> b
snd (Compose (ParseResults s) [] (s, m a)
 -> Compose (ParseResults s) [] (m a))
-> (ResultListT m g s a -> Compose (ParseResults s) [] (s, m a))
-> ResultListT m g s a
-> Compose (ParseResults s) [] (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure 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)))]
 -> [(ParserInput (ParserT m g s),
      g (GrammarFunctor (ParserT m g s)))])
-> [(ParserInput (ParserT m g s),
     g (GrammarFunctor (ParserT m g s)))]
-> [(ParserInput (ParserT m g s),
     g (GrammarFunctor (ParserT m g s)))]
forall a b. (a -> b) -> a -> b
$ g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
forall (g :: (* -> *) -> *) s (m :: * -> *).
(Functor g, FactorialMonoid s) =>
g (ParserT m g s) -> s -> [(s, g (ResultListT m g s))]
parseGrammarTails g (ParserT m g s)
g 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

-- | Memoizing parser that carries an applicative computation. Can be wrapped with
-- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.
instance (Applicative m, Eq s, LeftReductive s, FactorialMonoid s) => GrammarParsing (ParserT m g s) where
   type ParserGrammar (ParserT m g s) = g
   type GrammarFunctor (ParserT m g s) = ResultListT m g s
   parsingResult :: ParserInput (ParserT m g s)
-> GrammarFunctor (ParserT m g s) a
-> ResultFunctor (ParserT m g s) (ParserInput (ParserT m g s), a)
parsingResult ParserInput (ParserT m g s)
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 g (ResultListT m g s) -> ResultListT m g s a
f = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p where
      p :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
p input :: [(s, g (ResultListT m g s))]
input@((s
_, g (ResultListT m g s)
d) : [(s, g (ResultListT m g s))]
_) = [ResultsOfLengthT m g s a] -> 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]
rs' FailureInfo s
failure
         where ResultList [ResultsOfLengthT m g s a]
rs FailureInfo s
failure = g (ResultListT m g s) -> ResultListT m g s a
f g (ResultListT m g s)
d
               rs' :: [ResultsOfLengthT m g s a]
rs' = ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a
sync (ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a)
-> [ResultsOfLengthT m g s a] -> [ResultsOfLengthT m g s a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLengthT m g s a]
rs
               -- in left-recursive grammars the stored input remainder may be wrong, so revert to the complete input
               sync :: ResultsOfLengthT m g s a -> ResultsOfLengthT m g s a
sync (ResultsOfLengthT (ROL Int
0 [(s, g (ResultListT m g s))]
_remainder NonEmpty (m a)
r)) = ResultsOfLength m g s (m a) -> ResultsOfLengthT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
ResultsOfLengthT (Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty (m a)
-> ResultsOfLength m g s (m a)
forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
ROL Int
0 [(s, g (ResultListT m g s))]
input NonEmpty (m a)
r)
               sync ResultsOfLengthT m g s a
rs = ResultsOfLengthT m g s a
rs
      p [(s, g (ResultListT m g s))]
_ = [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
0 [String -> Expected s
forall s. String -> Expected s
Expected String
"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 (ParserT m g s)
g s
input = (s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))])
-> [(s, g (ResultListT m g s))]
-> [s]
-> [(s, g (ResultListT m g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
   where parseTail :: s -> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
parseTail s
s [(s, g (ResultListT m g s))]
parsedTail = [(s, g (ResultListT m g s))]
parsed
            where parsed :: [(s, g (ResultListT m g s))]
parsed = (s
s,g (ResultListT m g s)
d)(s, g (ResultListT m g s))
-> [(s, g (ResultListT m g s))] -> [(s, g (ResultListT m g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultListT m g s))]
parsedTail
                  d :: g (ResultListT m g s)
d      = (forall a. ParserT m g s a -> ResultListT m g s a)
-> g (ParserT m g s) -> g (ResultListT m g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultListT m g s))]
parsed) (([(s, g (ResultListT m g s))] -> ResultListT m g s a)
 -> ResultListT m g s a)
-> (ParserT m g s a
    -> [(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
-> ResultListT m g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m g s a
-> [(s, g (ResultListT m g s))] -> ResultListT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser) g (ParserT m g s)
g

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

instance InputParsing (ParserT m g s)  => TraceableParsing (ParserT m g s) where
   traceInput :: (ParserInput (ParserT m g s) -> String)
-> ParserT m g s a -> ParserT m g s a
traceInput ParserInput (ParserT m g s) -> String
description (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q rest :: [(s, g (ResultListT m g s))]
rest@((s
s, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_) = case String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Parsing " ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
                                of rl :: ResultListT m g s a
rl@(ResultList [] FailureInfo s
_) -> String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Failed " ResultListT m g s a
rl
                                   ResultListT m g s a
rl -> String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
"Parsed " ResultListT m g s a
rl
               where traceWith :: String -> ResultListT m g s a -> ResultListT m g s a
traceWith String
prefix = String -> ResultListT m g s a -> ResultListT m g s a
forall a. String -> a -> a
trace (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParserInput (ParserT m g s) -> String
description s
ParserInput (ParserT m g s)
s)

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

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

instance (Applicative m, MonoidNull s) => Parsing (ParserT m g s) where
   try :: ParserT m g s a -> ParserT m g s a
try (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = ResultListT m g s a -> ResultListT m g s a
rewindFailure ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
               where rewindFailure :: ResultListT m g s a -> ResultListT m g s a
rewindFailure (ResultList [ResultsOfLengthT m g s a]
rl (FailureInfo Int
_pos [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 [(s, g (ResultListT m g s))] -> ResultListT m g s a
p <?> :: ParserT m g s a -> String -> ParserT m g s a
<?> String
msg  = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q
      where q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = ResultListT m g s a -> ResultListT m g s a
replaceFailure ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
rest)
               where replaceFailure :: ResultListT m g s a -> ResultListT m g s a
replaceFailure (ResultList [] (FailureInfo Int
pos [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 ResultListT m g s a
rl = ResultListT m g s a
rl
   notFollowedBy :: ParserT m g s a -> ParserT m g s ()
notFollowedBy (Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
p) = ([(s, g (ResultListT m g s))] -> ResultListT m g s ())
-> ParserT m g s ()
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
input-> [(s, g (ResultListT m g s))]
-> ResultListT m g s a -> ResultListT m g s ()
forall (m :: * -> *) s (g :: (* -> *) -> *) (m :: * -> *)
       (g :: (* -> *) -> *) s r.
Applicative m =>
[(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s ()
rewind [(s, g (ResultListT m g s))]
input ([(s, g (ResultListT m g s))] -> ResultListT m g s a
p [(s, g (ResultListT m g s))]
input))
      where rewind :: [(s, g (ResultListT m g s))]
-> ResultListT m g s r -> ResultListT m g s ()
rewind [(s, g (ResultListT m g s))]
t (ResultList [] FailureInfo 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 Int
0 [(s, g (ResultListT m g s))]
t ()
            rewind [(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 String
"notFollowedBy"])
   skipMany :: ParserT m g s a -> ParserT m g s ()
skipMany ParserT m g s a
p = ParserT m g s ()
go
      where go :: ParserT m g s ()
go = () -> ParserT m g s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () ParserT m g s () -> ParserT m g s () -> ParserT m g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT m g s a -> ParserT m g s a
forall (m :: * -> *) a. Parsing m => m a -> m a
try ParserT m g s a
p ParserT m g s a -> ParserT m g s () -> ParserT m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT m g s ()
go
   unexpected :: String -> ParserT m g s a
unexpected String
msg = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser (\[(s, g (ResultListT m g s))]
t-> [ResultsOfLengthT m g s a] -> 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, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_)
               | s -> Bool
forall m. MonoidNull m => m -> Bool
null s
s = Int -> [(s, g (ResultListT m g s))] -> () -> ResultListT m g s ()
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
0 [(s, g (ResultListT m g s))]
rest ()
               | Bool
otherwise = [ResultsOfLengthT m g s ()]
-> 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 String
"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 Int
0 [] ()

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

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

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

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

-- | 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 ParserT Identity g s a
p = ([(s, g (ResultListT Identity g s))]
 -> Result g [(s, g (ResultListT Identity g s))] a)
-> Parser g [(s, g (ResultListT Identity g s))] a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
q where
   q :: [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] a
q [(s, g (ResultListT Identity g s))]
rest = case ParserT Identity g s a
-> [(s, g (ResultListT Identity g s))]
-> ResultListT Identity g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ParserT m g s r
-> [(s, g (ResultListT m g s))] -> ResultListT m g s r
applyParser ParserT Identity g s a
p [(s, g (ResultListT Identity g s))]
rest
            of ResultList [] (FailureInfo Int
pos [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 [ResultsOfLengthT Identity g s a]
rs FailureInfo s
_ -> ResultsOfLengthT Identity g s a
-> Result g [(s, g (ResultListT Identity g s))] a
forall (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
ResultsOfLengthT Identity g s v
-> Result g [(s, g (ResultListT Identity g s))] v
parsed ([ResultsOfLengthT Identity g s a]
-> ResultsOfLengthT Identity g s a
forall a. [a] -> a
last [ResultsOfLengthT Identity g s a]
rs)
   parsed :: ResultsOfLengthT Identity g s v
-> Result g [(s, g (ResultListT Identity g s))] v
parsed (ResultsOfLengthT (ROL Int
l [(s, g (ResultListT Identity g s))]
s (Identity v
r:|[Identity v]
_))) = Int
-> v
-> [(s, g (ResultListT Identity g s))]
-> Result g [(s, g (ResultListT Identity g s))] v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultListT Identity g s))]
s
   message :: Expected a -> Expected [(a, b)]
message (Expected String
msg) = String -> Expected [(a, b)]
forall s. String -> Expected s
Expected String
msg
   message (ExpectedInput a
s) = [(a, b)] -> Expected [(a, b)]
forall s. s -> Expected s
ExpectedInput [(a
s, String -> b
forall a. HasCallStack => String -> a
error String
"longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
peg :: Applicative m => Backtrack.Parser g [(s, g (ResultListT m g s))] a -> ParserT m g s a
peg :: Parser g [(s, g (ResultListT m g s))] a -> ParserT m g s a
peg Parser g [(s, g (ResultListT m g s))] a
p = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q where
   q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [(s, g (ResultListT m g s))]
rest = case Parser g [(s, g (ResultListT m g s))] a
-> [(s, g (ResultListT m g s))]
-> Result g [(s, g (ResultListT m g s))] a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultListT m g s))] a
p [(s, g (ResultListT m g s))]
rest
            of Backtrack.Parsed Int
l a
result [(s, g (ResultListT m g s))]
suffix -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 Int
pos [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 Parser g s a
p = ([(s, g (ResultListT m g s))] -> ResultListT m g s a)
-> ParserT m g s a
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
([(s, g (ResultListT m g s))] -> ResultListT m g s r)
-> ParserT m g s r
Parser [(s, g (ResultListT m g s))] -> ResultListT m g s a
q where
   q :: [(s, g (ResultListT m g s))] -> ResultListT m g s a
q [] = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
forall a. Monoid a => a
mempty
            of Backtrack.Parsed Int
l a
result s
_ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r
singleResult Int
l [] a
result
               Backtrack.NoParse 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, g (ResultListT m g s)
_):[(s, g (ResultListT m g s))]
_) = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
                       of Backtrack.Parsed Int
l a
result s
_ -> Int -> [(s, g (ResultListT m g s))] -> a -> ResultListT m g s a
forall (m :: * -> *) s (g :: (* -> *) -> *) r.
Applicative m =>
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 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 (ResultList [] (FailureInfo Int
pos [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
+ Int
1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList s
_ (ResultList [ResultsOfLengthT m g s r]
rl 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 Int
_ ((a
s, g (ResultListT m g a)
_):[(a, g (ResultListT m g a))]
_) NonEmpty (m r)
r)) = (,) a
s (m r -> (a, m r)) -> [m r] -> [(a, m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m r) -> [m r]
forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
         f (ResultsOfLengthT (ROL Int
_ [] NonEmpty (m r)
r)) = (,) a
forall a. Monoid a => a
mempty (m r -> (a, m r)) -> [m r] -> [(a, m r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (m r) -> [m r]
forall a. NonEmpty a -> [a]
toList NonEmpty (m r)
r
{-# INLINABLE fromResultList #-}

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

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

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

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

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

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

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

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

instance 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
(<>)

instance FallibleResults (ResultListT m g) where
   hasSuccess :: ResultListT m g s a -> Bool
hasSuccess (ResultList [] FailureInfo s
_) = Bool
False
   hasSuccess ResultListT m g s a
_ = Bool
True
   failureOf :: ResultListT m g s a -> FailureInfo s
failureOf (ResultList [ResultsOfLengthT m g s a]
_ FailureInfo s
failure) = FailureInfo s
failure
   failWith :: FailureInfo s -> ResultListT m g s a
failWith = [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 []