{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
-- | A context-free memoizing parser that handles all alternatives in parallel.
module Text.Grampa.ContextFree.SortedMemoizing 
       (ParseFailure(..), ResultList(..), Parser(..),
        longest, peg, terminalPEG)
where

import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
#if MIN_VERSION_base(4,13,0)
import Control.Monad (MonadFail(fail))
#endif
import Data.Either (partitionEithers)
import Data.Functor.Compose (Compose(..))
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty, toList)
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.Ord (Down(Down))
import Data.Semigroup (Semigroup((<>)))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)
import Debug.Trace (trace)
import Witherable (Filterable(mapMaybe))

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

import qualified Rank2

import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
                          AmbiguousParsing(..), Ambiguous(Ambiguous), CommittedParsing(..),
                          ConsumedInputParsing(..), DeterministicParsing(..),
                          TailsParsing(parseTails, parseAllTails), ParseResults, ParseFailure(..),
                          FailureDescription(..))
import Text.Grampa.Internal (ResultList(..), ResultsOfLength(..), TraceableParsing(..),
                             emptyFailure, expected, expectedInput, replaceExpected, erroneous)
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack

import Prelude hiding (iterate, 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{forall (g :: (* -> *) -> *) s r.
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 :: forall a b. (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) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, g (ResultList g i))] -> ResultList g i a
p)
   {-# INLINE fmap #-}

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

instance Ord s => Alternative (Parser g s) where
   empty :: forall a. Parser g s a
empty = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
   Parser [(s, g (ResultList g s))] -> ResultList g s a
p <|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<|> Parser [(s, g (ResultList g s))] -> ResultList g s a
q = 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 = [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
   {-# INLINE (<|>) #-}
   {-# INLINABLE empty #-}

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

instance Ord s => Monad (Parser g s) where
   return :: forall a. a -> Parser g s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   >> :: forall a b. Parser g s a -> Parser g s b -> Parser g s b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
   Parser [(s, g (ResultList g s))] -> ResultList g s a
p >>= :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = 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 b
q where
      q :: [(s, g (ResultList g s))] -> ResultList g s b
q [(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 [ResultsOfLength g s a]
results ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g s a -> ResultList g s b
continue [ResultsOfLength g s a]
results
      continue :: ResultsOfLength g s a -> ResultList g s b
continue (ResultsOfLength Int
l [(s, g (ResultList g s))]
rest' NonEmpty a
rs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultList g s r -> ResultList g s r
continue' Int
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser [(s, g (ResultList g s))]
rest' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser g s b
f) NonEmpty a
rs
      continue' :: Int -> ResultList g s r -> ResultList g s r
continue' Int
l (ResultList [ResultsOfLength g s r]
rs ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust Int
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s r]
rs) ParseFailure (Down Int) 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) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (Int
lforall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' NonEmpty r
rs

#if MIN_VERSION_base(4,13,0)
instance Ord s => MonadFail (Parser g s) where
#endif
   fail :: forall a. String -> Parser g s a
fail String
msg = 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))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
msg)

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

instance (Semigroup x, Ord s) => Semigroup (Parser g s x) where
   <> :: 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 forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid x, Ord s) => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
   mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions. Can be wrapped with
-- 'Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive.Fixed' to provide left recursion support.
instance (Ord 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 :: forall a.
ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult ParserInput (Parser g s)
_ = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList
   nonTerminal :: (Rank2.Functor g, ParserInput (Parser g s) ~ s) => (g (ResultList g s) -> ResultList g s a) -> Parser g s a
   nonTerminal :: forall a.
(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
f = 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 input :: [(s, g (ResultList g s))]
input@((s
_, g (ResultList g s)
d) : [(s, g (ResultList g s))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [ResultsOfLength g s a]
rs' ParseFailure (Down Int) s
failure
         where ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
failure = g (ResultList g s) -> ResultList g s a
f g (ResultList g s)
d
               rs' :: [ResultsOfLength g s a]
rs' = ResultsOfLength g s a -> ResultsOfLength g s a
sync forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs
               -- in left-recursive grammars the stored input remainder may be wrong, so revert to the current input
               sync :: ResultsOfLength g s a -> ResultsOfLength g s a
sync (ResultsOfLength Int
0 [(s, g (ResultList g s))]
_remainder NonEmpty a
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))]
input NonEmpty a
r
               sync ResultsOfLength g s a
rol = ResultsOfLength g s a
rol
      p [(s, g (ResultList g s))]
_ = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"NonTerminal at endOfInput")
   {-# INLINE nonTerminal #-}
   chainRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultList g s))] -> ResultList g s a
base) (Parser [(s, g (ResultList g s))] -> ResultList g s a
recurse) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g f)] -> ResultList g s a
q
      where q :: [(s, g f)] -> ResultList g s a
q [] = [(s, g (ResultList g s))] -> ResultList g s a
base []
            q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultList g s))] -> ResultList g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                           of r :: ResultList g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultList g s a
r
                              ResultList g s a
r -> ResultList g s a -> ResultList g s a -> ResultList g s a
iter ResultList g s a
r ResultList g s a
r
               where iter :: ResultList g s a -> ResultList g s a -> ResultList g s a
iter f a
marginal ResultList g s a
total = case [(s, g (ResultList g s))] -> ResultList g s a
recurse ((s
s, f a -> g f -> g f
assign f a
marginal g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                                           of ResultList [] ParseFailure (Down Int) s
_ -> ResultList g s a
total
                                              ResultList g s a
r -> ResultList g s a -> ResultList g s a -> ResultList g s a
iter ResultList g s a
r (ResultList g s a
total forall a. Semigroup a => a -> a -> a
<> ResultList g s a
r)
   chainLongestRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainLongestRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultList g s))] -> ResultList g s a
base) (Parser [(s, g (ResultList g s))] -> ResultList g s a
recurse) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g f)] -> ResultList g s a
q
      where q :: [(s, g f)] -> ResultList g s a
q [] = [(s, g (ResultList g s))] -> ResultList g s a
base []
            q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultList g s))] -> ResultList g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                           of r :: ResultList g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultList g s a
r
                              ResultList g s a
r -> ResultList g s a -> f a
iter ResultList g s a
r
               where iter :: ResultList g s a -> f a
iter f a
r = case [(s, g (ResultList g s))] -> ResultList g s a
recurse ((s
s, f a -> g f -> g f
assign f a
r g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                              of ResultList [] ParseFailure (Down Int) s
_ -> f a
r
                                 ResultList g s a
r' -> ResultList g s a -> f a
iter ResultList g s a
r'

instance (Ord s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
   parseTails :: forall (g :: (* -> *) -> *) r.
GrammarConstraint (Parser g s) g =>
Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = 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. Can be wrapped with
-- 'Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive.Fixed' to provide left recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (LeftReductive s, FactorialMonoid s, Ord 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 :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
 Eq s, FactorialMonoid s) =>
g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ 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)
   -- parseComplete :: (ParserInput (Parser g s) ~ s, Rank2.Functor g, Eq s, FactorialMonoid s) =>
   --                  g (Parser g s) -> s -> g (Compose (ParseResults s) [])
   parseComplete :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
 Eq s, FactorialMonoid s) =>
g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList)
                              (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
eof) g (Parser g s)
g

fromResultList :: FactorialMonoid s => ResultList g s r -> ParseResults s [(s, r)]
fromResultList :: forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList (ResultList [] (ParseFailure Down Int
pos FailureDescription s
expected' [String]
erroneous')) =
   forall a b. a -> Either a b
Left (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Down Int
pos forall a. Num a => a -> a -> a
- Down Int
1) FailureDescription s
expected' [String]
erroneous')
fromResultList (ResultList [ResultsOfLength g s r]
rl ParseFailure (Down Int) s
_failure) = forall a b. b -> Either a b
Right (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {g :: (* -> *) -> *} {a}.
Monoid a =>
ResultsOfLength g a a -> [(a, a)]
f [ResultsOfLength g s r]
rl)
   where f :: ResultsOfLength g a a -> [(a, a)]
f (ResultsOfLength Int
_ ((a
s, g (ResultList g a)
_):[(a, g (ResultList g a))]
_) NonEmpty a
r) = (,) a
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty a
r
         f (ResultsOfLength Int
_ [] NonEmpty a
r) = (,) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty a
r

parseGrammarTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails :: 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 = 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 [] (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)forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsedTail
                  d :: g (ResultList g s)
d      = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))]
parsed) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, Ord s) => InputParsing (Parser g s) where
   type ParserInput (Parser g s) = s
   getInput :: Parser g s (ParserInput (Parser g s))
getInput = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {r} {g :: (* -> *) -> *}.
(Ord r, 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))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {r} {g :: (* -> *) -> *}.
(FactorialMonoid r, Ord 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 forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
                                of Just (r
first, r
_) -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                                   Maybe (r, r)
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(r, g (ResultList g r))]
rest) String
"anyToken")
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"anyToken")
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = 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 forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
               of Just (s
first, s
_) | ParserInput (Parser g s) -> Bool
predicate s
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                  Maybe (s, s)
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfy")
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfy")
   scan :: forall state.
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 = 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))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
               where (s
prefix, s
_, state
_) = forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> ParserInput (Parser g s) -> Maybe state
f s
i
                     l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
0 = forall a. Monoid a => a
mempty
   take Int
n = 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 <- forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Eq a => a -> a -> Bool
== Int
n =
                    forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ 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 = 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 <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
                    forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] 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 = 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 <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
                    forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"takeWhile1")
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (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))]
_)
         | ParserInput (Parser g s)
s forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) (ParserInput (Parser g s)
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
      p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> s -> ParseFailure (Down Int) s
expectedInput (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) ParserInput (Parser g s)
s)
      l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length ParserInput (Parser g s)
s
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = 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
_) <- forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
first = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfy")
            p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
   {-# INLINABLE string #-}

instance (InputParsing (Parser g s), FactorialMonoid s) => TraceableParsing (Parser g s) where
   traceInput :: forall a.
(ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case forall a. String -> a -> a
trace (String
"Parsing " forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
s) ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest) of
               rl :: ResultList g s a
rl@(ResultList [] ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Failed " forall a. Semigroup a => a -> a -> a
<> (s -> s) -> String
descriptionWith forall a. a -> a
id) ResultList g s a
rl
               rl :: ResultList g s a
rl@(ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Parsed [" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ResultsOfLength g s a -> String
describeResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) forall a. Semigroup a => a -> a -> a
<> String
"]") ResultList g s a
rl
               where describeResult :: ResultsOfLength g s a -> String
describeResult (ResultsOfLength Int
len [(s, g (ResultList g s))]
_ NonEmpty a
_) = (s -> s) -> String
descriptionWith (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
len)
                     descriptionWith :: (s -> s) -> String
descriptionWith s -> s
f = ParserInput (Parser g s) -> String
description (s -> s
f s
s)
            q [] = [(s, g (ResultList g s))] -> ResultList g s a
p []

instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = 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 forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (forall m. Factorial m => m -> m
Factorial.primePrefix s
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                  Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfyCharInput")
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfyCharInput")
   scanChars :: forall state.
state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = 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))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
               where (s
prefix, 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 = forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
                    forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
                    forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"takeCharsWhile1")
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfyChar")
            p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty

instance (LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (Parser g s) where
   match :: forall a. Parser g s a -> Parser g s (ParserInput (Parser g s), a)
match (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 [] = forall {a} {g :: (* -> *) -> *} {s} {a}.
FactorialMonoid a =>
a -> ResultList g s a -> ResultList g s (a, a)
addConsumed 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))]
_) = forall {a} {g :: (* -> *) -> *} {s} {a}.
FactorialMonoid a =>
a -> ResultList g s a -> ResultList g s (a, a)
addConsumed s
s ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
            addConsumed :: a -> ResultList g s a -> ResultList g s (a, a)
addConsumed a
input (ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (ResultsOfLength g s a -> ResultsOfLength g s (a, a)
add1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rl) ParseFailure (Down Int) s
failure
               where add1 :: ResultsOfLength g s a -> ResultsOfLength g s (a, a)
add1 (ResultsOfLength Int
l [(s, g (ResultList g s))]
t NonEmpty a
rs) = 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 ((,) (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
l a
input) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
rs)

instance (MonoidNull s, Ord s) => Parsing (Parser g s) where
   try :: forall a. Parser g s a -> Parser g s a
try (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 ParseFailure (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [ResultsOfLength g s a]
rl (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest)
   Parser [(s, g (ResultList g s))] -> ResultList g s a
p <?> :: forall a. Parser g s a -> String -> Parser g s a
<?> String
msg  = 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 [] ParseFailure (Down Int) s
f) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] (forall s.
Down Int
-> String -> ParseFailure (Down Int) s -> ParseFailure (Down Int) s
replaceExpected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
msg ParseFailure (Down Int) s
f)
                     replaceFailure ResultList g s a
rl = ResultList g s a
rl
   notFollowedBy :: forall a. Show a => Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> forall {s} {g :: (* -> *) -> *} {g :: (* -> *) -> *} {s} {r}.
Ord s =>
[(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 [] ParseFailure (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
            rewind [(s, g (ResultList g s))]
t ResultList{} = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
t) String
"notFollowedBy")
   skipMany :: forall a. Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
      where go :: Parser g s ()
go = forall (f :: * -> *) a. Applicative f => a -> f a
pure () forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser g s a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
   unexpected :: forall a. String -> Parser g s a
unexpected String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
t-> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
t) String
msg)
   eof :: Parser g s ()
eof = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {s} {g :: (* -> *) -> *}.
(MonoidNull s, Ord 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))]
_)
               | forall m. MonoidNull m => m -> Bool
null s
s = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
               | Bool
otherwise = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"end of input")
            f [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty

instance (MonoidNull s, Ord s) => DeterministicParsing (Parser g s) where
   Parser [(s, g (ResultList g s))] -> ResultList g s a
p <<|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser [(s, g (ResultList g s))] -> ResultList g s a
q = 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 [] ParseFailure (Down Int) s
_failure) -> ResultList g s a
rl 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 :: forall a. Parser g s a -> Parser g s [a]
takeSome Parser g s a
p = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany Parser g s a
p
   takeMany :: forall a. Parser g s a -> Parser g s [a]
takeMany (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 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 [] ParseFailure (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 [] forall a. a -> [a] -> NonEmpty a
:| [])] forall a. Monoid a => a
mempty
                           ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
_ -> 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) = 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 forall a. Num a => a -> a -> a
+ Int
len') ([a] -> [a]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
rforall a. a -> [a] -> [a]
:)) [(s, g (ResultList g s))]
rest') NonEmpty a
results
   skipAll :: forall a. Parser g s a -> Parser g s ()
skipAll (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 [] ParseFailure (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                       ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
_failure -> 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 forall a. Num a => a -> a -> a
+ Int
len') [(s, g (ResultList g s))]
rest'

instance (MonoidNull s, Ord s) => LookAheadParsing (Parser g s) where
   lookAhead :: forall a. Parser g s a -> Parser g s a
lookAhead (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> 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 [] ParseFailure (Down Int) s
_) = ResultList g s r
rl
            rewind [(s, g (ResultList g s))]
t (ResultList [ResultsOfLength g s r]
rl ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Semigroup a => a -> a -> a
(<>) (forall {g :: (* -> *) -> *} {s} {r}.
ResultsOfLength g s r -> NonEmpty r
results forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s r]
rl)] ParseFailure (Down Int) s
failure
            results :: ResultsOfLength g s r -> NonEmpty r
results (ResultsOfLength Int
_ [(s, g (ResultList g s))]
_ NonEmpty r
r) = NonEmpty r
r

instance (Ord s, Show s, TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = 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 forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                  Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"Char.satisfy")
            p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"Char.satisfy")
   string :: String -> Parser g s String
string String
s = forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text Text
t = (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance Ord s => AmbiguousParsing (Parser g s) where
   ambiguous :: forall a. Parser g s a -> Parser g s (Ambiguous a)
ambiguous (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 ParseFailure (Down Int) s
failure <- [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {a}.
ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) ParseFailure (Down Int) 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) = 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 (forall a. NonEmpty a -> Ambiguous a
Ambiguous NonEmpty a
rs forall a. a -> [a] -> NonEmpty a
:| [])

instance Ord s => CommittedParsing (Parser g s) where
   type CommittedResults (Parser g s) = ParseResults s
   commit :: forall a.
Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = 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 (Either (ParseFailure (Down Int) s) a)
q
      where q :: [(s, g (ResultList g s))]
-> ResultList g s (Either (ParseFailure (Down Int) s) a)
q [(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 [] ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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 (forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failureforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                        ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rl) ParseFailure (Down Int) s
failure
   admit :: forall a.
Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser [(s, g (ResultList g s))]
-> ResultList g s (CommittedResults (Parser g s) a)
p) = 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 [(s, g (ResultList g s))]
-> ResultList g s (CommittedResults (Parser g s) a)
p [(s, g (ResultList g s))]
rest
                     of ResultList [] ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] ParseFailure (Down Int) s
failure
                        ResultList [ResultsOfLength g s (CommittedResults (Parser g s) a)]
rl ParseFailure (Down Int) s
failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {s} {g :: (* -> *) -> *} {r}.
Ord s =>
ResultsOfLength g s (Either (ParseFailure (Down Int) s) r)
-> ResultList g s r
expose [ResultsOfLength g s (CommittedResults (Parser g s) a)]
rl forall a. Semigroup a => a -> a -> a
<> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] ParseFailure (Down Int) s
failure
            expose :: ResultsOfLength g s (Either (ParseFailure (Down Int) s) r)
-> ResultList g s r
expose (ResultsOfLength Int
len [(s, g (ResultList g s))]
t NonEmpty (Either (ParseFailure (Down Int) s) r)
rs) = case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [r]
successes of
               Maybe (NonEmpty r)
Nothing -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
               Just NonEmpty r
successes' -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
len [(s, g (ResultList g s))]
t NonEmpty r
successes'] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
               where ([ParseFailure (Down Int) s]
failures, [r]
successes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a. NonEmpty a -> [a]
toList NonEmpty (Either (ParseFailure (Down Int) s) r)
rs)
        
-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
-- of input tails, opposite of 'peg'
longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: forall (g :: (* -> *) -> *) s a.
Parser g s a -> Parser g [(s, g (ResultList g s))] a
longest Parser g s a
p = 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 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 [] (ParseFailure Down Int
pos (FailureDescription [String]
expected [s]
inputs) [String]
errors)
                  -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
Backtrack.NoParse (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. a -> [(a, b)]
wrap [s]
inputs) [String]
errors)
               ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
_ -> forall {g :: (* -> *) -> *} {s} {v} {g :: (* -> *) -> *}.
ResultsOfLength g s v -> Result g [(s, g (ResultList g s))] v
parsed (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]
_)) = forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultList g s))]
s
   wrap :: a -> [(a, b)]
wrap a
s = [(a
s, 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 :: Ord s => Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg :: forall s (g :: (* -> *) -> *) a.
Ord s =>
Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg Parser g [(s, g (ResultList g s))] a
p = 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 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 -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [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
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
               Backtrack.NoParse (ParseFailure Down Int
pos (FailureDescription [String]
expected [[(s, g (ResultList g s))]]
inputs) [String]
errors)
                  -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(s, g (ResultList g s))]]
inputs)) [String]
errors)

-- | Turns a backtracking PEG parser into a context-free parser
terminalPEG :: Monoid s => Ord s => Backtrack.Parser g s a -> Parser g s a
terminalPEG :: forall s (g :: (* -> *) -> *) a.
(Monoid s, Ord s) =>
Parser g s a -> Parser g s a
terminalPEG Parser g s a
p = 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 forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p forall a. Monoid a => a
mempty
            of Backtrack.Parsed Int
l a
result s
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [] (a
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
               Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure
   q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case 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
_ -> 
                             forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (a
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
                          Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure