{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.SortedMemoizing 
       (FailureInfo(..), ResultList(..), Parser(..), (<<|>),
        reparseTails, 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.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Cancellative (isPrefixOf)
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.String (fromString)

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

import qualified Rank2

import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..), AmbiguousParsing(..),
                          Ambiguous(Ambiguous), ParseResults)
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 f :: a -> b
f (Parser p :: [(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
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 (\rest :: [(i, g (ResultList g i))]
rest-> [ResultsOfLength g i a] -> FailureInfo -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [(i, g (ResultList g i))]
rest (a
aa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty)
   Parser p :: [(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 q :: [(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 rest :: [(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 results :: [ResultsOfLength g i (a -> b)]
results failure :: FailureInfo
failure -> [ResultsOfLength g i b] -> FailureInfo -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g i b]
forall a. Monoid a => a
mempty FailureInfo
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 l :: Int
l rest' :: [(i, g (ResultList g i))]
rest' fs :: 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' l :: Int
l (ResultList rs :: [ResultsOfLength g s a]
rs failure :: FailureInfo
failure) f :: a -> r
f = [ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
failure
      adjust :: Int -> (a -> r) -> ResultsOfLength g s a -> ResultsOfLength g s r
adjust l :: Int
l f :: a -> r
f (ResultsOfLength l' :: Int
l' rest' :: [(s, g (ResultList g s))]
rest' as :: 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 (\rest :: [(i, g (ResultList g i))]
rest-> [ResultsOfLength g i a] -> FailureInfo -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g i a]
forall a. Monoid a => a
mempty (FailureInfo -> ResultList g i a)
-> FailureInfo -> ResultList g i a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo ([(i, g (ResultList g i))] -> Int
forall i a. Num i => [a] -> i
genericLength [(i, g (ResultList g i))]
rest) [])
   Parser p :: [(i, g (ResultList g i))] -> ResultList g i a
p <|> :: Parser g i a -> Parser g i a -> Parser g i a
<|> Parser q :: [(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 rest :: [(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 #-}

infixl 3 <<|>
(<<|>) :: Parser g s a -> Parser g s a -> Parser g s a
Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p <<|> :: Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser q :: [(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 rest :: [(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 [] _failure :: FailureInfo
_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
               rl :: ResultList g s a
rl -> ResultList g s a
rl

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 p :: [(i, g (ResultList g i))] -> ResultList g i a
p >>= :: Parser g i a -> (a -> Parser g i b) -> Parser g i b
>>= f :: 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 rest :: [(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 results :: [ResultsOfLength g i a]
results failure :: FailureInfo
failure -> [ResultsOfLength g i b] -> FailureInfo -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g i b]
forall a. Monoid a => a
mempty FailureInfo
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 l :: Int
l rest' :: [(i, g (ResultList g i))]
rest' rs :: 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' l :: Int
l (ResultList rs :: [ResultsOfLength g s r]
rs failure :: FailureInfo
failure) = [ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
failure
      adjust :: Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust l :: Int
l (ResultsOfLength l' :: Int
l' rest' :: [(s, g (ResultList g s))]
rest' rs :: 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 GrammarParsing Parser where
   type GrammarFunctor Parser = ResultList
   nonTerminal :: (g (GrammarFunctor Parser g s) -> GrammarFunctor Parser g s a)
-> Parser g s a
nonTerminal f :: g (GrammarFunctor Parser g s) -> GrammarFunctor Parser 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 ((_, d :: g (ResultList g s)
d) : _) = g (GrammarFunctor Parser g s) -> GrammarFunctor Parser g s a
f g (GrammarFunctor Parser g s)
g (ResultList g s)
d
      p _ = [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["NonTerminal at endOfInput"])
   {-# INLINE nonTerminal #-}

-- | 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' [])
-- @
instance MultiParsing Parser where
   type ResultFunctor Parser = Compose ParseResults []
   -- | 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) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a.
 ResultList g s a -> Compose (Compose ParseResults []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (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 (Compose ParseResults [] (s, a)
-> Compose (Compose ParseResults []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose ParseResults [] (s, a)
 -> Compose (Compose ParseResults []) ((,) s) a)
-> (ResultList g s a -> Compose ParseResults [] (s, a))
-> ResultList g s a
-> Compose (Compose ParseResults []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a))
-> (ResultList g s a -> Either ParseFailure [(s, a)])
-> ResultList g s a
-> Compose ParseResults [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either ParseFailure [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> ResultList g s r -> ParseResults [(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))]
parseTails g (Parser g s)
g s
input)
   parseComplete :: forall g s. (Rank2.Functor g, FactorialMonoid s) =>
                    g (Parser g s) -> s -> g (Compose ParseResults [])
   parseComplete :: g (Parser g s) -> s -> g (Compose ParseResults [])
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a. ResultList g s a -> Compose ParseResults [] a)
-> g (ResultList g s) -> g (Compose ParseResults [])
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, a) -> Compose ParseResults [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose ParseResults [] (s, a) -> Compose ParseResults [] a)
-> (ResultList g s a -> Compose ParseResults [] (s, a))
-> ResultList g s a
-> Compose ParseResults [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a))
-> (ResultList g s a -> Either ParseFailure [(s, a)])
-> ResultList g s a
-> Compose ParseResults [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either ParseFailure [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> ResultList g s r -> ParseResults [(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, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails g (Parser g s)
close ([(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))]
parseTails 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 :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput) g (Parser g s)
g

parseTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails :: g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails g :: g (Parser g s)
g input :: 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 parsedTail :: [(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

reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails :: g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails _ [] = []
reparseTails final :: g (Parser g s)
final parsed :: [(s, g (ResultList g s))]
parsed@((s :: s
s, _):_) = (s
s, g (ResultList g s)
gd)(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))]
parsed
   where gd :: g (ResultList g s)
gd = (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 (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` [(s, g (ResultList g s))]
parsed) g (Parser g s)
final

instance MonoidParsing (Parser g) where
   endOfInput :: Parser g s ()
endOfInput = Parser g s ()
forall (m :: * -> *). Parsing m => m ()
eof
   getInput :: Parser g s 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@((s :: r
s, _):_) = [ResultsOfLength g r r] -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [(r, g (ResultList g r))]
rest (r
sr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g r r] -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [] (r
forall a. Monoid a => a
memptyr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   anyToken :: Parser g s 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@((s :: r
s, _):t :: [(r, g (ResultList g r))]
t) = case r -> Maybe (r, r)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
                                of Just (first :: r
first, _) -> [ResultsOfLength g r r] -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 1 [(r, g (ResultList g r))]
t (r
firstr -> [r] -> NonEmpty r
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
                                   _ -> [ResultsOfLength g r r] -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g r r]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(r, g (ResultList g r))] -> Int
forall i a. Num i => [a] -> i
genericLength [(r, g (ResultList g r))]
rest) ["anyToken"])
            p [] = [ResultsOfLength g r r] -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g r r]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["anyToken"])
   satisfy :: (s -> Bool) -> Parser g s s
satisfy predicate :: 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
s, _):t :: [(s, g (ResultList g s))]
t) =
               case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
               of Just (first :: s
first, _) | s -> Bool
predicate s
first -> [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 1 [(s, g (ResultList g s))]
t (s
firsts -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
                  _ -> [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfy"])
            p [] = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfy"])
   satisfyChar :: (Char -> Bool) -> Parser g s Char
satisfyChar predicate :: 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
s, _):t :: [(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: Char
first | Char -> Bool
predicate Char
first -> [ResultsOfLength g s Char] -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 1 [(s, g (ResultList g s))]
t (Char
firstChar -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
                  _ -> [ResultsOfLength g s Char] -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s Char]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfyChar"])
            p [] = [ResultsOfLength g s Char] -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s Char]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyChar"])
   satisfyCharInput :: (Char -> Bool) -> Parser g s s
satisfyCharInput predicate :: 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
s, _):t :: [(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: Char
first | Char -> Bool
predicate Char
first -> [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 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
forall a. Monoid a => a
mempty
                  _ -> [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfyCharInput"])
            p [] = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyCharInput"])
   scan :: s -> (s -> t -> Maybe s) -> Parser g t t
scan s0 :: s
s0 f :: s -> t -> Maybe s
f = ([(t, g (ResultList g t))] -> ResultList g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (s -> [(t, g (ResultList g t))] -> ResultList g t t
p s
s0)
      where p :: s -> [(t, g (ResultList g t))] -> ResultList g t t
p s :: s
s rest :: [(t, g (ResultList g t))]
rest@((i :: t
i, _) : _) = [ResultsOfLength g t t] -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [Int
-> [(t, g (ResultList g t))] -> NonEmpty t -> ResultsOfLength g t t
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(t, g (ResultList g t))] -> [(t, g (ResultList g t))]
forall a. Int -> [a] -> [a]
drop Int
l [(t, g (ResultList g t))]
rest) (t
prefixt -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
               where (prefix :: t
prefix, _, _) = s -> (s -> t -> Maybe s) -> t -> (t, t, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s s -> t -> Maybe s
f t
i
                     l :: Int
l = t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix
            p _ [] = [ResultsOfLength g t t] -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [Int
-> [(t, g (ResultList g t))] -> NonEmpty t -> ResultsOfLength g t t
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength 0 [] (t
forall a. Monoid a => a
memptyt -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   scanChars :: s -> (s -> Char -> Maybe s) -> Parser g t t
scanChars s0 :: s
s0 f :: s -> Char -> Maybe s
f = ([(t, g (ResultList g t))] -> ResultList g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (s -> [(t, g (ResultList g t))] -> ResultList g t t
p s
s0)
      where p :: s -> [(t, g (ResultList g t))] -> ResultList g t t
p s :: s
s rest :: [(t, g (ResultList g t))]
rest@((i :: t
i, _) : _) = [ResultsOfLength g t t] -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [Int
-> [(t, g (ResultList g t))] -> NonEmpty t -> ResultsOfLength g t t
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (Int -> [(t, g (ResultList g t))] -> [(t, g (ResultList g t))]
forall a. Int -> [a] -> [a]
drop Int
l [(t, g (ResultList g t))]
rest) (t
prefixt -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
               where (prefix :: t
prefix, _, _) = s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s s -> Char -> Maybe s
f t
i
                     l :: Int
l = t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix
            p _ [] = [ResultsOfLength g t t] -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [Int
-> [(t, g (ResultList g t))] -> NonEmpty t -> ResultsOfLength g t t
forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength 0 [] (t
forall a. Monoid a => a
memptyt -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   takeWhile :: (s -> Bool) -> Parser g s s
takeWhile predicate :: 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
s, _) : _)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   takeWhile1 :: (s -> Bool) -> Parser g s s
takeWhile1 predicate :: 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
s, _) : _)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
                    [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
            p rest :: [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["takeWhile1"])
   takeCharsWhile :: (Char -> Bool) -> Parser g s s
takeCharsWhile predicate :: 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
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 -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
            p [] = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [] (s
forall a. Monoid a => a
memptys -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s s
takeCharsWhile1 predicate :: 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
s, _) : _)
               | s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
                    [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
            p rest :: [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["takeCharsWhile1"])
   string :: s -> Parser g s s
string s :: 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
s', _) : _)
         | s
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
ss -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
      p rest :: [(s, g (ResultList g s))]
rest = [ResultsOfLength g s s] -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s s]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s])
      l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s
   notSatisfy :: (s -> Bool) -> Parser g s ()
notSatisfy predicate :: 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
s, _):_)
               | Just (first :: s
first, _) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 s -> Bool
predicate s
first = [ResultsOfLength g s ()] -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["notSatisfy"])
            p rest :: [(s, g (ResultList g s))]
rest = [ResultsOfLength g s ()] -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [(s, g (ResultList g s))]
rest (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar predicate :: 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
s, _):_)
               | Just first :: 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 -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s ()]
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["notSatisfyChar"])
            p rest :: [(s, g (ResultList g s))]
rest = [ResultsOfLength g s ()] -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 0 [(s, g (ResultList g s))]
rest (()() -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:|[])] FailureInfo
forall a. Monoid a => a
mempty
   {-# INLINABLE string #-}

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

instance MonoidNull s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser p :: [(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 (\input :: [(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 _ rl :: ResultList g s r
rl@(ResultList [] _) = ResultList g s r
rl
            rewind t :: [(s, g (ResultList g s))]
t (ResultList rl :: [ResultsOfLength g s r]
rl failure :: FailureInfo
failure) = [ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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 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
failure
            results :: ResultsOfLength g s r -> NonEmpty r
results (ResultsOfLength _ _ r :: 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) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar
   string :: String -> Parser g s String
string s :: String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   char :: Char -> Parser g s Char
char = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
   notChar :: Char -> Parser g s Char
notChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
   anyChar :: Parser g s Char
anyChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
   text :: Text -> Parser g s Text
text t :: Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
   someSpace :: Parser g s ()
someSpace = Parser g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
someLexicalSpace
   semi :: Parser g s Char
semi = Parser g s Char
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s Char
lexicalSemicolon
   token :: Parser g s a -> Parser g s a
token = Parser g s a -> Parser g s a
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
       a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken

instance AmbiguousParsing (Parser g s) where
   ambiguous :: Parser g s a -> Parser g s (Ambiguous a)
ambiguous (Parser p :: [(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 rest :: [(s, g (ResultList g s))]
rest | ResultList rs :: [ResultsOfLength g s a]
rs failure :: FailureInfo
failure <- [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = [ResultsOfLength g s (Ambiguous a)]
-> FailureInfo -> ResultList g s (Ambiguous a)
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
failure
            groupByLength :: ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength (ResultsOfLength l :: Int
l rest :: [(s, g (ResultList g s))]
rest rs :: 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 p :: 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 rest :: [(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 [] failure :: FailureInfo
failure -> FailureInfo -> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
Backtrack.NoParse FailureInfo
failure
               ResultList rs :: [ResultsOfLength g s a]
rs _ -> 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 l :: Int
l s :: [(s, g (ResultList g s))]
s (r :: v
r:|_)) = 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

-- | 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 p :: 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 rest :: [(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 l :: Int
l result :: a
result suffix :: [(s, g (ResultList g s))]
suffix -> [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
               Backtrack.NoParse failure :: FailureInfo
failure -> [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty FailureInfo
failure

-- | 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 p :: 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 l :: Int
l result :: a
result _ -> [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
               Backtrack.NoParse failure :: FailureInfo
failure -> [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty FailureInfo
failure
   q rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_) = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
                       of Backtrack.Parsed l :: Int
l result :: a
result _ -> 
                             [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> 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
forall a. Monoid a => a
mempty
                          Backtrack.NoParse failure :: FailureInfo
failure -> [ResultsOfLength g s a] -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> FailureInfo -> ResultList g s r
ResultList [ResultsOfLength g s a]
forall a. Monoid a => a
mempty FailureInfo
failure