{-# LANGUAGE BangPatterns, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.SortedMemoizing 
       (FailureInfo(..), ResultList(..), Parser(..),
        longest, peg, terminalPEG)
where

import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
import Data.Functor.Compose (Compose(..))
import Data.List (genericLength)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Monoid (Monoid(mappend, mempty))
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 (Semigroup((<>)))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)

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

import qualified Rank2

import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
                          AmbiguousParsing(..), Ambiguous(Ambiguous),
                          ConsumedInputParsing(..), DeterministicParsing(..),
                          TailsParsing(parseTails, parseAllTails), ParseResults, Expected(..))
import Text.Grampa.Internal (FailureInfo(..), ResultList(..), ResultsOfLength(..), fromResultList)
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 of parse results. It does not support left-recursive
-- grammars.
newtype Parser g s r = Parser{Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser :: [(s, g (ResultList g s))] -> ResultList g s r}

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

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

instance Alternative (Parser g i) where
   empty :: Parser g i a
empty = ([(i, g (ResultList g i))] -> ResultList g i a) -> Parser g i a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(i, g (ResultList g i))]
rest-> [ResultsOfLength g i a] -> FailureInfo i -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g i a]
forall a. Monoid a => a
mempty (FailureInfo i -> ResultList g i a)
-> FailureInfo i -> ResultList g i a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected i] -> FailureInfo i
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(i, g (ResultList g i))] -> Int
forall i a. Num i => [a] -> i
genericLength [(i, g (ResultList g i))]
rest) [])
   Parser [(i, g (ResultList g i))] -> ResultList g i a
p <|> :: Parser g i a -> Parser g i a -> Parser g i a
<|> Parser [(i, g (ResultList g i))] -> ResultList g i a
q = ([(i, g (ResultList g i))] -> ResultList g i a) -> Parser g i a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(i, g (ResultList g i))] -> ResultList g i a
r where
      r :: [(i, g (ResultList g i))] -> ResultList g i a
r [(i, g (ResultList g i))]
rest = [(i, g (ResultList g i))] -> ResultList g i a
p [(i, g (ResultList g i))]
rest ResultList g i a -> ResultList g i a -> ResultList g i a
forall a. Semigroup a => a -> a -> a
<> [(i, g (ResultList g i))] -> ResultList g i a
q [(i, g (ResultList g i))]
rest
   {-# INLINE (<|>) #-}
   {-# INLINABLE empty #-}

instance Monad (Parser g i) where
   return :: a -> Parser g i a
return = a -> Parser g i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   >> :: Parser g i a -> Parser g i b -> Parser g i b
(>>) = Parser g i a -> Parser g i b -> Parser g i b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
   Parser [(i, g (ResultList g i))] -> ResultList g i a
p >>= :: Parser g i a -> (a -> Parser g i b) -> Parser g i b
>>= a -> Parser g i b
f = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(i, g (ResultList g i))] -> ResultList g i b
q where
      q :: [(i, g (ResultList g i))] -> ResultList g i b
q [(i, g (ResultList g i))]
rest = case [(i, g (ResultList g i))] -> ResultList g i a
p [(i, g (ResultList g i))]
rest
               of ResultList [ResultsOfLength g i a]
results FailureInfo i
failure -> [ResultsOfLength g i b] -> FailureInfo i -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g i b]
forall a. Monoid a => a
mempty FailureInfo i
failure ResultList g i b -> ResultList g i b -> ResultList g i b
forall a. Semigroup a => a -> a -> a
<> (ResultsOfLength g i a -> ResultList g i b)
-> [ResultsOfLength g i a] -> ResultList g i b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g i a -> ResultList g i b
continue [ResultsOfLength g i a]
results
      continue :: ResultsOfLength g i a -> ResultList g i b
continue (ResultsOfLength Int
l [(i, g (ResultList g i))]
rest' NonEmpty a
rs) = (a -> ResultList g i b) -> NonEmpty a -> ResultList g i b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> ResultList g i b -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
Int -> ResultList g s r -> ResultList g s r
continue' Int
l (ResultList g i b -> ResultList g i b)
-> (a -> ResultList g i b) -> a -> ResultList g i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser g i b -> [(i, g (ResultList g i))] -> ResultList g i b)
-> [(i, g (ResultList g i))] -> Parser g i b -> ResultList g i b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser g i b -> [(i, g (ResultList g i))] -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser [(i, g (ResultList g i))]
rest' (Parser g i b -> ResultList g i b)
-> (a -> Parser g i b) -> a -> ResultList g i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser g i b
f) NonEmpty a
rs
      continue' :: Int -> ResultList g s r -> ResultList g s r
continue' Int
l (ResultList [ResultsOfLength g s r]
rs FailureInfo s
failure) = [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList (Int -> ResultsOfLength g s r -> ResultsOfLength g s r
forall (g :: (* -> *) -> *) s r.
Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust Int
l (ResultsOfLength g s r -> ResultsOfLength g s r)
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s r]
rs) FailureInfo s
failure
      adjust :: Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust Int
l (ResultsOfLength Int
l' [(s, g (ResultList g s))]
rest' NonEmpty r
rs) = Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' NonEmpty r
rs

instance MonadPlus (Parser g s) where
   mzero :: Parser g s a
mzero = Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: Parser g s a -> Parser g s a -> Parser g s a
mplus = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Semigroup x => Semigroup (Parser g s x) where
   <> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser 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 Monoid x => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
   mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser 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

instance (Eq s, LeftReductive s, FactorialMonoid s) => GrammarParsing (Parser g s) where
   type ParserGrammar (Parser g s) = g
   type GrammarFunctor (Parser g s) = ResultList g s
   parsingResult :: ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult ParserInput (Parser g s)
s = Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (Either (ParseFailure s)) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList s
ParserInput (Parser g s)
s
   nonTerminal :: (Rank2.Functor g, ParserInput (Parser g s) ~ s) => (g (ResultList g s) -> ResultList g s a) -> Parser g s a
   nonTerminal :: (g (ResultList g s) -> ResultList g s a) -> Parser g s a
nonTerminal g (ResultList g s) -> ResultList g s a
f = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p where
      p :: [(s, g (ResultList g s))] -> ResultList g s a
p ((s
_, g (ResultList g s)
d) : [(s, g (ResultList g s))]
_) = g (ResultList g s) -> ResultList g s a
f g (ResultList g s)
d
      p [(s, g (ResultList g s))]
_ = [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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 (Eq s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
   parseTails :: Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser

-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left
-- recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (LeftReductive s, FactorialMonoid s) => MultiParsing (Parser g s) where
   type GrammarConstraint (Parser g s) g' = (g ~ g', Rank2.Functor g)
   type ResultFunctor (Parser g s) = Compose (ParseResults s) []
   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
   parsePrefix :: g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = (forall a.
 ResultList g s a
 -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (Compose (ParseResults s) []) ((,) 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 (Either (ParseFailure s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure s)) [] (s, a)
 -> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a)
-> (ResultList g s a
    -> Compose (Either (ParseFailure s)) [] (s, a))
-> ResultList g s a
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (Either (ParseFailure s)) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList s
input) ((s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a, b) -> b
snd ((s, g (ResultList g s)) -> g (ResultList g s))
-> (s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
   parseComplete :: (ParserInput (Parser g s) ~ s, Rank2.Functor g, Eq s, FactorialMonoid s) =>
                    g (Parser g s) -> s -> g (Compose (ParseResults s) [])
   parseComplete :: g (Parser g s) -> s -> g (Compose (ParseResults s) [])
parseComplete g (Parser g s)
g s
input = (forall a. ResultList g s a -> Compose (ParseResults s) [] a)
-> g (ResultList g s) -> g (Compose (ParseResults 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, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
 -> Compose (ParseResults s) [] a)
-> (ResultList g s a -> Compose (ParseResults s) [] (s, a))
-> ResultList g s a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (ParseResults s) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (ParseResults s) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (ParseResults s) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList s
input)
                              ((s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a, b) -> b
snd ((s, g (ResultList g s)) -> g (ResultList g s))
-> (s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s)
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser 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 (Parser g s)
close ([(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
 -> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))])
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g s
input)
      where close :: g (Parser g s)
close = (forall a. Parser g s a -> Parser g s a)
-> g (Parser g s) -> g (Parser 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 (Parser g s a -> Parser g s () -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser g s ()
forall (m :: * -> *). Parsing m => m ()
eof) g (Parser g s)
g

parseGrammarTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails :: g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g s
input = (s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))])
-> [(s, g (ResultList g s))] -> [s] -> [(s, g (ResultList g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
   where parseTail :: s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail s
s [(s, g (ResultList g s))]
parsedTail = [(s, g (ResultList g s))]
parsed
            where parsed :: [(s, g (ResultList g s))]
parsed = (s
s,g (ResultList g s)
d)(s, g (ResultList g s))
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsedTail
                  d :: g (ResultList g s)
d      = (forall a. Parser g s a -> ResultList g s a)
-> g (Parser g s) -> g (ResultList 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 (ResultList g s))] -> ResultList g s a)
-> [(s, g (ResultList g s))] -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))]
parsed) (([(s, g (ResultList g s))] -> ResultList g s a)
 -> ResultList g s a)
-> (Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a)
-> Parser g s a
-> ResultList g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser) g (Parser g s)
g

instance (LeftReductive s, FactorialMonoid s) => InputParsing (Parser g s) where
   type ParserInput (Parser g s) = s
   getInput :: Parser g s (ParserInput (Parser g s))
getInput = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
Monoid r =>
[(r, g (ResultList g r))] -> ResultList g r r
p
      where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((r
s, g (ResultList g r)
_):[(r, g (ResultList g r))]
_) = [ResultsOfLength g r r] -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(r, g (ResultList g r))] -> NonEmpty r -> ResultsOfLength g r r
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(r, g (ResultList g r))]
rest (r
sr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo r
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g r r] -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(r, g (ResultList g r))] -> NonEmpty r -> ResultsOfLength g r r
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (r
forall a. Monoid a => a
memptyr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo r
forall a. Monoid a => a
mempty
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
FactorialMonoid r =>
[(r, g (ResultList g r))] -> ResultList g r r
p
      where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((r
s, g (ResultList g r)
_):[(r, g (ResultList g r))]
t) = case r -> Maybe (r, r)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
                                of Just (r
first, r
_) -> [ResultsOfLength g r r] -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(r, g (ResultList g r))] -> NonEmpty r -> ResultsOfLength g r r
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(r, g (ResultList g r))]
t (r
firstr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo r
forall a. Monoid a => a
mempty
                                   Maybe (r, r)
_ -> [ResultsOfLength g r r] -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g r r]
forall a. Monoid a => a
mempty (Int -> [Expected r] -> FailureInfo r
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(r, g (ResultList g r))] -> Int
forall i a. Num i => [a] -> i
genericLength [(r, g (ResultList g r))]
rest) [String -> Expected r
forall s. String -> Expected s
Expected String
"anyToken"])
            p [] = [ResultsOfLength g r r] -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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 (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList 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 (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (s
firsts -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
                  Maybe (s, s)
_ -> [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfy"])
            p [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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 (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan state
s0 state -> ParserInput (Parser g s) -> Maybe state
f = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
               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 (Parser g s) -> Maybe state
f s
i
                     l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
0 = Parser g s (ParserInput (Parser g s))
forall a. Monoid a => a
mempty
   take Int
n = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList 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 =
                    [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList 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])
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
   takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser 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 =
                    [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeWhile1"])
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p where
      p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s', g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
         | s
ParserInput (Parser g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) (s
ParserInput (Parser g s)
ss -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
      p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [s -> Expected s
forall s. s -> Expected s
ExpectedInput s
ParserInput (Parser g s)
s])
      l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | Just (s
first, s
_) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfy"])
            p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty ()
-> ResultsOfLength g s ()
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
   {-# INLINABLE string #-}

instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList 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 -> [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
ss -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
                  Maybe Char
_ -> [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfyCharInput"])
            p [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
               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
_ [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList 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 =
                    [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList 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 =
                    [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty s -> ResultsOfLength g s s
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xs -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeCharsWhile1"])
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | Just Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfyChar"])
            p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty ()
-> ResultsOfLength g s ()
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty

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

instance MonoidNull s => Parsing (Parser g s) where
   try :: Parser g s a -> Parser g s a
try (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
rewindFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where rewindFailure :: ResultList g s a -> ResultList g s a
rewindFailure (ResultList [ResultsOfLength g s a]
rl (FailureInfo Int
_pos [Expected s]
_msgs)) =
                        [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s a]
rl (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [])
   Parser [(s, g (ResultList g s))] -> ResultList g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg  = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
replaceFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where replaceFailure :: ResultList g s a -> ResultList g s a
replaceFailure (ResultList [] (FailureInfo Int
pos [Expected s]
msgs)) =
                        [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList 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 (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest then [String -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
msgs)
                     replaceFailure ResultList g s a
rl = ResultList g s a
rl
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s ()
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s r.
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
      where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
t (ResultList [] FailureInfo s
_) = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty ()
-> ResultsOfLength g s ()
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
t (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
            rewind [(s, g (ResultList g s))]
t ResultList{} = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected String
"notFollowedBy"])
   skipMany :: Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
      where go :: Parser g s ()
go = () -> Parser g s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Parser g s () -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser g s a -> Parser g s a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser g s a
p Parser g s a -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
   unexpected :: String -> Parser g s a
unexpected String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
t-> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList g s a)
-> FailureInfo s -> ResultList 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 (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
   eof :: Parser g s ()
eof = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
forall s (g :: (* -> *) -> *).
MonoidNull s =>
[(s, g (ResultList g s))] -> ResultList g s ()
f
      where f :: [(s, g (ResultList g s))] -> ResultList g s ()
f rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | s -> Bool
forall m. MonoidNull m => m -> Bool
null s
s = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty ()
-> ResultsOfLength g s ()
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
               | Bool
otherwise = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"end of input"])
            f [] = [ResultsOfLength g s ()] -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty ()
-> ResultsOfLength g s ()
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty

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

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

instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s Char)
-> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s Char
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s Char
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList 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 -> [ResultsOfLength g s Char] -> FailureInfo s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))]
-> NonEmpty Char
-> ResultsOfLength g s Char
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (Char
firstChar -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
                  Maybe Char
_ -> [ResultsOfLength g s Char] -> FailureInfo s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s Char]
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"Char.satisfy"])
            p [] = [ResultsOfLength g s Char] -> FailureInfo s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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 -> Parser 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) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser 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 -> Parser 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) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser 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 AmbiguousParsing (Parser g s) where
   ambiguous :: Parser g s a -> Parser g s (Ambiguous a)
ambiguous (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s (Ambiguous a))
-> Parser g s (Ambiguous a)
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s (Ambiguous a)
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s (Ambiguous a)
q [(s, g (ResultList g s))]
rest | ResultList [ResultsOfLength g s a]
rs FailureInfo s
failure <- [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s (Ambiguous a)]
-> FailureInfo s -> ResultList g s (Ambiguous a)
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList (ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
forall (g :: (* -> *) -> *) s a.
ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength (ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a))
-> [ResultsOfLength g s a] -> [ResultsOfLength g s (Ambiguous a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) FailureInfo s
failure
            groupByLength :: ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength (ResultsOfLength Int
l [(s, g (ResultList g s))]
rest NonEmpty a
rs) = Int
-> [(s, g (ResultList g s))]
-> NonEmpty (Ambiguous a)
-> ResultsOfLength g s (Ambiguous a)
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
rest (NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous NonEmpty a
rs Ambiguous a -> [Ambiguous a] -> NonEmpty (Ambiguous a)
forall a. a -> [a] -> NonEmpty a
:| [])

-- | 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 :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: Parser g s a -> Parser g [(s, g (ResultList g s))] a
longest Parser g s a
p = ([(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a)
-> Parser g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q where
   q :: [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q [(s, g (ResultList g s))]
rest = case Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser Parser g s a
p [(s, g (ResultList g s))]
rest
            of ResultList [] (FailureInfo Int
pos [Expected s]
expected) -> FailureInfo [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
Backtrack.NoParse (Int
-> [Expected [(s, g (ResultList g s))]]
-> FailureInfo [(s, g (ResultList g s))]
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected [(s, g (ResultList g s))]]
 -> FailureInfo [(s, g (ResultList g s))])
-> [Expected [(s, g (ResultList g s))]]
-> FailureInfo [(s, g (ResultList g s))]
forall a b. (a -> b) -> a -> b
$ (Expected s -> Expected [(s, g (ResultList g s))])
-> [Expected s] -> [Expected [(s, g (ResultList g s))]]
forall a b. (a -> b) -> [a] -> [b]
map Expected s -> Expected [(s, g (ResultList g s))]
forall a b. Expected a -> Expected [(a, b)]
message [Expected s]
expected)
               ResultList [ResultsOfLength g s a]
rs FailureInfo s
_ -> ResultsOfLength g s a -> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
ResultsOfLength g s v -> Result g [(s, g (ResultList g s))] v
parsed ([ResultsOfLength g s a] -> ResultsOfLength g s a
forall a. [a] -> a
last [ResultsOfLength g s a]
rs)
   parsed :: ResultsOfLength g s v -> Result g [(s, g (ResultList g s))] v
parsed (ResultsOfLength Int
l [(s, g (ResultList g s))]
s (v
r:|[v]
_)) = Int
-> v
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultList 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 :: Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg :: Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg Parser g [(s, g (ResultList g s))] a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = case Parser g [(s, g (ResultList g s))] a
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultList g s))] a
p [(s, g (ResultList g s))]
rest
            of Backtrack.Parsed Int
l a
result [(s, g (ResultList g s))]
suffix -> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty a -> ResultsOfLength g s a
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
suffix (a
resulta -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
               Backtrack.NoParse (FailureInfo Int
pos [Expected [(s, g (ResultList g s))]]
expected) -> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength 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 (ResultList g s)) -> s
forall a b. (a, b) -> a
fst ((s, g (ResultList g s)) -> s)
-> ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> s)
-> Expected [(s, g (ResultList g s))] -> Expected s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Expected [(s, g (ResultList g s))] -> Expected s)
-> [Expected [(s, g (ResultList g s))]] -> [Expected s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expected [(s, g (ResultList g s))]]
expected))

-- | Turns a backtracking PEG parser into a context-free parser
terminalPEG :: Monoid s => Backtrack.Parser g s a -> Parser g s a
terminalPEG :: Parser g s a -> Parser g s a
terminalPEG Parser g s a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList 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
_ -> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty a -> ResultsOfLength g s a
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [] (a
resulta -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
               Backtrack.NoParse FailureInfo s
failure -> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty FailureInfo s
failure
   q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList 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
_ -> 
                             [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [Int
-> [(s, g (ResultList g s))] -> NonEmpty a -> ResultsOfLength g s a
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (a
resulta -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo s
forall a. Monoid a => a
mempty
                          Backtrack.NoParse FailureInfo s
failure -> [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty FailureInfo s
failure