{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs, MultiParamTypeClasses,
             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
-- | A context-free parser with packrat-like memoization of parse results.
module Text.Grampa.ContextFree.Memoizing
       (ResultList(..), Parser(..), BinTree(..), reparseTails, 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.Function (on)
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (maximumBy)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid, length, 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(..), MultiParsing(..),
                          DeterministicParsing(..), InputParsing(..), InputCharParsing(..),
                          TailsParsing(parseTails), ParseResults, ParseFailure(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (BinTree(..), AmbiguousAlternative (..), FallibleResults (..), TraceableParsing(..),
                             Dependencies (..), ParserFlags (..),
                             emptyFailure, erroneous, expected, expectedInput, replaceExpected)
import Text.Grampa.Internal.Storable (Storable(..), Storable1(..))
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{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}

data ResultList g s r = ResultList !(BinTree (ResultInfo g s r)) (ParseFailure Pos s)
data ResultInfo g s r = ResultInfo !Int ![(s, g (ResultList g s))] r

instance (Show s, Show r) => Show (ResultList g s r) where
   show :: ResultList g s r -> String
show (ResultList BinTree (ResultInfo g s r)
l ParseFailure Pos s
f) = String
"ResultList (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinTree (ResultInfo g s r) -> ShowS
forall a. Show a => a -> ShowS
shows BinTree (ResultInfo g s r)
l (String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseFailure Pos s -> ShowS
forall a. Show a => a -> ShowS
shows ParseFailure Pos s
f String
")")

instance Show s => Show1 (ResultList g s) where
   liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList g s a -> ShowS
liftShowsPrec Int -> a -> ShowS
_sp [a] -> ShowS
showList Int
_prec (ResultList BinTree (ResultInfo g s a)
l ParseFailure Pos s
f) String
rest = String
"ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (ResultInfo g s a -> a
forall {g :: (* -> *) -> *} {s} {r}. ResultInfo g s r -> r
simplify (ResultInfo g s a -> a) -> [ResultInfo g s a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a) -> [ResultInfo g s a]
forall a. BinTree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo g s a)
l) (ParseFailure Pos s -> ShowS
forall a. Show a => a -> ShowS
shows ParseFailure Pos s
f String
rest)
      where simplify :: ResultInfo g s r -> r
simplify (ResultInfo Int
_ [(s, g (ResultList g s))]
_ r
r) = r
r

instance (Show s, Show r) => Show (ResultInfo g s r) where
   show :: ResultInfo g s r -> String
show (ResultInfo Int
l [(s, g (ResultList g s))]
_ r
r) = String
"(ResultInfo @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> ShowS
forall a. Show a => a -> ShowS
shows r
r String
")"

instance Functor (ResultInfo g s) where
   fmap :: forall a b. (a -> b) -> ResultInfo g s a -> ResultInfo g s b
fmap a -> b
f (ResultInfo Int
l [(s, g (ResultList g s))]
t a
r) = Int -> [(s, g (ResultList g s))] -> b -> ResultInfo g s b
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
t (a -> b
f a
r)

instance Ord s => Applicative (ResultInfo g s) where
   pure :: forall a. a -> ResultInfo g s a
pure = Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
forall a. Monoid a => a
mempty
   ResultInfo Int
l1 [(s, g (ResultList g s))]
_ a -> b
f <*> :: forall a b.
ResultInfo g s (a -> b) -> ResultInfo g s a -> ResultInfo g s b
<*> ResultInfo Int
l2 [(s, g (ResultList g s))]
t2 a
x = Int -> [(s, g (ResultList g s))] -> b -> ResultInfo g s b
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) [(s, g (ResultList g s))]
t2 (a -> b
f a
x)

instance Foldable (ResultInfo g s) where
   foldMap :: forall m a. Monoid m => (a -> m) -> ResultInfo g s a -> m
foldMap a -> m
f (ResultInfo Int
_ [(s, g (ResultList g s))]
_ a
r) = a -> m
f a
r

instance Traversable (ResultInfo g s) where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultInfo g s a -> f (ResultInfo g s b)
traverse a -> f b
f (ResultInfo Int
l [(s, g (ResultList g s))]
t a
r) = Int -> [(s, g (ResultList g s))] -> b -> ResultInfo g s b
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
t (b -> ResultInfo g s b) -> f b -> f (ResultInfo g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
r

instance Functor (ResultList g s) where
   fmap :: forall a b. (a -> b) -> ResultList g s a -> ResultList g s b
fmap a -> b
f (ResultList BinTree (ResultInfo g s a)
l ParseFailure Pos s
failure) = BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList ((a -> b
f (a -> b) -> ResultInfo g s a -> ResultInfo g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo g s a -> ResultInfo g s b)
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a)
l) ParseFailure Pos s
failure

instance Filterable (ResultList g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> ResultList g s a -> ResultList g s b
mapMaybe a -> Maybe b
f (ResultList BinTree (ResultInfo g s a)
l ParseFailure Pos s
failure) = BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList ((ResultInfo g s a -> Maybe (ResultInfo g s b))
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall a b. (a -> Maybe b) -> BinTree a -> BinTree b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((a -> Maybe b) -> ResultInfo g s a -> Maybe (ResultInfo g s b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultInfo g s a -> f (ResultInfo g s b)
traverse a -> Maybe b
f) BinTree (ResultInfo g s a)
l) ParseFailure Pos s
failure

instance Ord s => Semigroup (ResultList g s r) where
   ResultList BinTree (ResultInfo g s r)
rl1 ParseFailure Pos s
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList BinTree (ResultInfo g s r)
rl2 ParseFailure Pos s
f2 = BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (BinTree (ResultInfo g s r)
rl1 BinTree (ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo g s r)
rl2) (ParseFailure Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)

instance Ord s => Monoid (ResultList g s r) where
   mempty :: ResultList g s r
mempty = BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s r)
forall a. Monoid a => a
mempty ParseFailure Pos s
forall a. Monoid a => a
mempty
   mappend :: ResultList g s r -> ResultList g s r -> ResultList g s r
mappend = ResultList g s r -> ResultList g s r -> ResultList g s r
forall a. Semigroup a => a -> a -> a
(<>)

instance FallibleResults (ResultList g) where
   hasSuccess :: forall s a. ResultList g s a -> Bool
hasSuccess (ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
_) = Bool
False
   hasSuccess ResultList g s a
_ = Bool
True
   failureOf :: forall s a. ResultList g s a -> ParseFailure Pos s
failureOf (ResultList BinTree (ResultInfo g s a)
_ ParseFailure Pos s
failure) = ParseFailure Pos s
failure
   failWith :: forall s a. ParseFailure Pos s -> ResultList g s a
failWith = BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. BinTree a
EmptyTree

instance Ord s => Applicative (ResultList g s) where
   pure :: forall a. a -> ResultList g s a
pure a
a = BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ a -> ResultInfo g s a
forall a. a -> ResultInfo g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) ParseFailure Pos s
forall a. Monoid a => a
mempty
   ResultList BinTree (ResultInfo g s (a -> b))
rl1 ParseFailure Pos s
f1 <*> :: forall a b.
ResultList g s (a -> b) -> ResultList g s a -> ResultList g s b
<*> ResultList BinTree (ResultInfo g s a)
rl2 ParseFailure Pos s
f2 = BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s (a -> b) -> ResultInfo g s a -> ResultInfo g s b
forall a b.
ResultInfo g s (a -> b) -> ResultInfo g s a -> ResultInfo g s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (ResultInfo g s (a -> b) -> ResultInfo g s a -> ResultInfo g s b)
-> BinTree (ResultInfo g s (a -> b))
-> BinTree (ResultInfo g s a -> ResultInfo g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s (a -> b))
rl1 BinTree (ResultInfo g s a -> ResultInfo g s b)
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall a b. BinTree (a -> b) -> BinTree a -> BinTree b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinTree (ResultInfo g s a)
rl2) (ParseFailure Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)

instance Ord s => Alternative (ResultList g s) where
   empty :: forall a. ResultList g s a
empty = ResultList g s a
forall a. Monoid a => a
mempty
   <|> :: forall a. ResultList g s a -> ResultList g s a -> ResultList g s a
(<|>) = ResultList g s a -> ResultList g s a -> ResultList g s a
forall a. Semigroup a => a -> a -> a
(<>)

instance Ord s => AmbiguousAlternative (ResultList g s) where
   ambiguousOr :: forall a.
ResultList g s (Ambiguous a)
-> ResultList g s (Ambiguous a) -> ResultList g s (Ambiguous a)
ambiguousOr (ResultList BinTree (ResultInfo g s (Ambiguous a))
rl1 ParseFailure Pos s
f1) (ResultList BinTree (ResultInfo g s (Ambiguous a))
rl2 ParseFailure Pos s
f2) = BinTree (ResultInfo g s (Ambiguous a))
-> ParseFailure Pos s -> ResultList g s (Ambiguous a)
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (BinTree (ResultInfo g s (Ambiguous a))
-> BinTree (ResultInfo g s (Ambiguous a))
-> BinTree (ResultInfo g s (Ambiguous a))
forall a. BinTree a -> BinTree a -> BinTree a
Fork BinTree (ResultInfo g s (Ambiguous a))
rl1 BinTree (ResultInfo g s (Ambiguous a))
rl2) (ParseFailure Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)

instance Storable1 (ResultList g s) Bool where
   store1 :: forall b. Bool -> ResultList g s b
store1 Bool
bit = BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s b)
forall a. BinTree a
EmptyTree (Pos -> ParseFailure Pos s
forall s. Pos -> ParseFailure Pos s
emptyFailure (Pos -> ParseFailure Pos s) -> Pos -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ if Bool
bit then Pos
1 else Pos
0)
   reuse1 :: forall b. ResultList g s b -> Bool
reuse1 (ResultList BinTree (ResultInfo g s b)
_ (ParseFailure Pos
pos FailureDescription s
_ [String]
_)) = Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
/= Pos
0

instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (ResultList g s) (ParserFlags g) where
   store1 :: forall b. ParserFlags g -> ResultList g s b
store1 ParserFlags g
a = BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s b -> BinTree (ResultInfo g s b)
forall a. a -> BinTree a
Leaf (ResultInfo g s b -> BinTree (ResultInfo g s b))
-> ResultInfo g s b -> BinTree (ResultInfo g s b)
forall a b. (a -> b) -> a -> b
$ ParserFlags g -> ResultInfo g s b
forall s a. Storable s a => a -> s
store ParserFlags g
a) ParseFailure Pos s
forall a. Monoid a => a
mempty
   reuse1 :: forall b. ResultList g s b -> ParserFlags g
reuse1 (ResultList (Leaf ResultInfo g s b
s) ParseFailure Pos s
_) = ResultInfo g s b -> ParserFlags g
forall s a. Storable s a => s -> a
reuse ResultInfo g s b
s

instance (Rank2.Functor g, Monoid s) => Storable (ResultInfo g s r) (ParserFlags g) where
   store :: ParserFlags g -> ResultInfo g s r
store (ParserFlags Bool
n Dependencies g
d) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (if Bool
n then Int
1 else Int
0) (Dependencies g -> [(s, g (ResultList g s))]
forall s a. Storable s a => a -> s
store Dependencies g
d) (String -> r
forall a. HasCallStack => String -> a
error String
"unused")
   reuse :: ResultInfo g s r -> ParserFlags g
reuse (ResultInfo Int
n [(s, g (ResultList g s))]
d r
_) = Bool -> Dependencies g -> ParserFlags g
forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(s, g (ResultList g s))] -> Dependencies g
forall s a. Storable s a => s -> a
reuse [(s, g (ResultList g s))]
d)

instance (Rank2.Functor g, Monoid s) => Storable [(s, g (ResultList g s))] (Dependencies g) where
   store :: Dependencies g -> [(s, g (ResultList g s))]
store Dependencies g
DynamicDependencies = []
   store (StaticDependencies g (Const Bool)
deps) = [(s
forall a. Monoid a => a
mempty, g (Const Bool) -> g (ResultList g s)
forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
   reuse :: [(s, g (ResultList g s))] -> Dependencies g
reuse [] = Dependencies g
forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
   reuse [(s
_, g (ResultList g s)
deps)] = g (Const Bool) -> Dependencies g
forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (g (ResultList g s) -> g (Const Bool)
forall s a. Storable s a => s -> a
reuse g (ResultList g s)
deps)

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) = ([(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 a b. (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)
   {-# INLINABLE fmap #-}

instance Ord s => Applicative (Parser g s) where
   pure :: forall a. a -> Parser g s a
pure a
a = ([(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))]
rest-> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest a
a) ParseFailure Pos s
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 = ([(s, g (ResultList g s))] -> ResultList g s b) -> Parser g s b
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 BinTree (ResultInfo g s (a -> b))
results ParseFailure Pos s
failure -> BinTree (ResultInfo g s b)
-> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s b)
forall a. Monoid a => a
mempty ParseFailure Pos s
failure ResultList g s b -> ResultList g s b -> ResultList g s b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo g s (a -> b) -> ResultList g s b)
-> BinTree (ResultInfo g s (a -> b)) -> ResultList g s b
forall m a. Monoid m => (a -> m) -> BinTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo g s (a -> b) -> ResultList g s b
continue BinTree (ResultInfo g s (a -> b))
results
      continue :: ResultInfo g s (a -> b) -> ResultList g s b
continue (ResultInfo Int
l [(s, g (ResultList g s))]
rest' a -> b
f) = Int -> (a -> b) -> ResultList g s a -> ResultList g s b
forall {t} {r} {g :: (* -> *) -> *} {s}.
Int -> (t -> r) -> ResultList g s t -> ResultList g s r
continue' Int
l a -> b
f ([(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest')
      continue' :: Int -> (t -> r) -> ResultList g s t -> ResultList g s r
continue' Int
l t -> r
f (ResultList BinTree (ResultInfo g s t)
rs ParseFailure Pos s
failure) = BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
forall {t} {r} {g :: (* -> *) -> *} {s}.
Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust Int
l t -> r
f (ResultInfo g s t -> ResultInfo g s r)
-> BinTree (ResultInfo g s t) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s t)
rs) ParseFailure Pos s
failure
      adjust :: Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust Int
l t -> r
f (ResultInfo Int
l' [(s, g (ResultList g s))]
rest' t
a) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' (t -> r
f t
a)
   {-# INLINABLE pure #-}
   {-# INLINABLE (<*>) #-}

instance Ord s => Alternative (Parser g s) where
   empty :: forall a. Parser g s a
empty = ([(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 (BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultList g s a)
-> ([(s, g (ResultList g s))] -> ParseFailure Pos s)
-> [(s, g (ResultList g s))]
-> ResultList g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> ParseFailure Pos s
forall s. Pos -> ParseFailure Pos s
emptyFailure (Pos -> ParseFailure Pos s)
-> ([(s, g (ResultList g s))] -> Pos)
-> [(s, g (ResultList g s))]
-> ParseFailure Pos s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pos
forall a. a -> Down a
Down (Int -> Pos)
-> ([(s, g (ResultList g s))] -> Int)
-> [(s, g (ResultList g s))]
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> 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 = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
r where
      r :: [(s, g (ResultList g s))] -> ResultList g s a
r [(s, g (ResultList g s))]
rest = [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest 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
   {-# INLINABLE (<|>) #-}

instance Filterable (Parser g i) where
   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g i a -> Parser g i b
mapMaybe a -> Maybe b
f (Parser [(i, g (ResultList g i))] -> ResultList g i a
p) = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser ((a -> Maybe b) -> ResultList g i a -> ResultList g i b
forall a b. (a -> Maybe b) -> ResultList g i a -> ResultList g i b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe 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)
   {-# INLINABLE mapMaybe #-}

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

#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 = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
erroneous (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> 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 = Parser g s a
forall a. Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: forall a. 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 a. 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, Ord s) => 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 a b c.
(a -> b -> c) -> Parser g s a -> Parser g s b -> Parser g s c
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, Ord s) => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = x -> Parser g s x
forall a. a -> Parser g s a
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 = Parser g s x -> Parser g s x -> Parser g s x
forall a. Semigroup a => a -> a -> a
(<>)

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)
_ = Either (ParseFailure Pos s) [(s, a)]
-> Compose (Either (ParseFailure Pos s)) [] (s, a)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [(s, a)]
 -> Compose (Either (ParseFailure Pos s)) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure Pos s) [(s, a)])
-> ResultList g s a
-> Compose (Either (ParseFailure Pos s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultList g s a -> Either (ParseFailure Pos s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList
   nonTerminal :: forall (g :: (* -> *) -> *) a.
(g ~ ParserGrammar (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a)
-> Parser g s a
nonTerminal 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))] -> GrammarFunctor (Parser g s) a
[(s, g (ResultList g s))] -> ResultList g s a
p where
      p :: [(s, g (ResultList g s))] -> GrammarFunctor (Parser g s) a
p ((s
_, g (ResultList g s)
d) : [(s, g (ResultList g s))]
_) = g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f g (ResultList g s)
g (GrammarFunctor (Parser g s))
d
      p [(s, g (ResultList g s))]
_ = BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
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) = ([(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
[(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 f a
forall a. Monoid a => a
mempty g f
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))]
[(s, g f)]
t)
                           of r :: ResultList g s a
r@(ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos 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) (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))]
[(s, g f)]
t)
                                           of ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos 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 ResultList g s a -> ResultList g s a -> ResultList g s a
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) = ([(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
[(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 f a
forall a. Monoid a => a
mempty g f
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))]
[(s, g f)]
t)
                           of r :: ResultList g s a
r@(ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos 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) (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))]
[(s, g f)]
t)
                              of ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos 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 = Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser

-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left
-- recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (LeftReductive s, FactorialMonoid s, 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 a.
 ResultList g s a
 -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (Compose (ParseResults s) []) ((,) s))
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (ParseResults s) [] (s, a)
-> Compose (Compose (ParseResults s) []) ((,) s) a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (ParseResults s) [] (s, a)
 -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> (ResultList g s a -> Compose (ParseResults s) [] (s, a))
-> ResultList g s a
-> Compose (Compose (ParseResults s) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [(s, a)]
-> Compose (ParseResults s) [] (s, a)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [(s, a)]
 -> Compose (ParseResults s) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure Pos s) [(s, a)])
-> ResultList g s a
-> Compose (ParseResults s) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultList g s a -> Either (ParseFailure Pos s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList) ((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. HasCallStack => [a] -> a
head ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
   -- parseComplete :: (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 a. ResultList g s a -> Compose (ParseResults s) [] a)
-> g (ResultList g s) -> g (Compose (ParseResults s) [])
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
 -> Compose (ParseResults s) [] a)
-> (ResultList g s a -> Compose (ParseResults s) [] (s, a))
-> ResultList g s a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [(s, a)]
-> Compose (ParseResults s) [] (s, a)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [(s, a)]
 -> Compose (ParseResults s) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure Pos s) [(s, a)])
-> ResultList g s a
-> Compose (ParseResults s) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultList g s a -> Either (ParseFailure Pos s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList)
                              ((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. HasCallStack => [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))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
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 a b. Parser g s a -> Parser g s b -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser g s ()
forall (m :: * -> *). Parsing m => m ()
eof) g (Parser g s)
g

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

reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails :: forall (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails g (Parser g s)
_ [] = []
reparseTails g (Parser g s)
final parsed :: [(s, g (ResultList g s))]
parsed@((s
s, g (ResultList g s)
_):[(s, g (ResultList g 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 (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 = ([(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 :: (* -> *) -> *}.
(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))]
_) = BinTree (ResultInfo g r r)
-> ParseFailure Pos r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(r, g (ResultList g r))]
rest r
s) ParseFailure Pos r
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g r r)
-> ParseFailure Pos r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] r
forall a. Monoid a => a
mempty) ParseFailure Pos r
forall a. Monoid a => a
mempty
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall {r} {g :: (* -> *) -> *}.
(FactorialMonoid r, 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 r -> Maybe (r, r)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
                                of Just (r
first, r
_) -> BinTree (ResultInfo g r r)
-> ParseFailure Pos r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
1 [(r, g (ResultList g r))]
t r
first) ParseFailure Pos r
forall a. Monoid a => a
mempty
                                   Maybe (r, r)
_ -> BinTree (ResultInfo g r r)
-> ParseFailure Pos r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos r
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(r, g (ResultList g r))] -> Int
forall m. Factorial m => m -> Int
length [(r, g (ResultList g r))]
rest) String
"anyToken")
            p [] = BinTree (ResultInfo g r r)
-> ParseFailure Pos r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos r
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"anyToken")
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
               case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
               of Just (s
first, s
_) | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
1 [(s, g (ResultList g s))]
t s
first) ParseFailure Pos s
forall a. Monoid a => a
mempty
                  Maybe (s, s)
_ -> BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfy")
            p [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
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 = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
prefix) ParseFailure Pos s
forall a. Monoid a => a
mempty
               where (s
prefix, s
_, state
_) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall s. s -> (s -> s -> Maybe s) -> s -> (s, s, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (Parser g s) -> Maybe state
f s
i
                     l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] s
forall a. Monoid a => a
mempty) ParseFailure Pos s
forall a. Monoid a => a
mempty
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
0 = Parser g s s
Parser g s (ParserInput (Parser g s))
forall a. Monoid a => a
mempty
   take Int
n = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n =
                    BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
x) ParseFailure Pos s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) (String -> ParseFailure Pos s) -> String -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
x) ParseFailure Pos s
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] s
forall a. Monoid a => a
mempty) ParseFailure Pos s
forall a. Monoid a => a
mempty
   takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                    BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
x) ParseFailure Pos s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> 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 = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p where
      p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s', g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
         | s
ParserInput (Parser g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) s
ParserInput (Parser g s)
s) ParseFailure Pos s
forall a. Monoid a => a
mempty
      p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> s -> ParseFailure Pos s
forall s. Pos -> s -> ParseFailure Pos s
expectedInput (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) s
ParserInput (Parser g s)
s)
      l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | Just (s
first, s
_) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfy")
            p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) ParseFailure Pos s
forall a. Monoid a => a
mempty
   {-# INLINABLE string #-}

instance InputParsing (Parser g 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) = ([(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@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case String -> ResultList g s a -> ResultList g s a
traceWith String
"Parsing " ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
                                of rl :: ResultList g s a
rl@(ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
_) -> String -> ResultList g s a -> ResultList g s a
traceWith String
"Failed " ResultList g s a
rl
                                   ResultList g s a
rl -> String -> ResultList g s a -> ResultList g s a
traceWith String
"Parsed " ResultList g s a
rl
               where traceWith :: String -> ResultList g s a -> ResultList g s a
traceWith String
prefix = String -> ResultList g s a -> ResultList g s a
forall a. String -> a -> a
trace (String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
ParserInput (Parser g 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 = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
1 [(s, g (ResultList g s))]
t (s -> ResultInfo g s s) -> s -> ResultInfo g s s
forall a b. (a -> b) -> a -> b
$ s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) ParseFailure Pos s
forall a. Monoid a => a
mempty
                  Maybe Char
_ -> BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfyCharInput")
            p [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
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 = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
prefix) ParseFailure Pos s
forall a. Monoid a => a
mempty
               where (s
prefix, s
_, state
_) = state -> (state -> Char -> Maybe state) -> s -> (s, s, state)
forall s. s -> (s -> Char -> Maybe s) -> s -> (s, s, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
                     l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p state
_ [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] s
forall a. Monoid a => a
mempty) ParseFailure Pos s
forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
x) ParseFailure Pos s
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] s
forall a. Monoid a => a
mempty) ParseFailure Pos s
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                    BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
x) ParseFailure Pos s
forall a. Monoid a => a
mempty
            p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s)
-> ParseFailure Pos s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"takeCharsWhile1")
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | Just Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfyChar")
            p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) ParseFailure Pos s
forall a. Monoid a => a
mempty

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) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
rewindFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where rewindFailure :: ResultList g s a -> ResultList g s a
rewindFailure (ResultList BinTree (ResultInfo g s a)
rl ParseFailure Pos s
_) = BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
rl (Pos -> ParseFailure Pos s
forall s. Pos -> ParseFailure Pos s
emptyFailure (Pos -> ParseFailure Pos s) -> Pos -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> 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  = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
replaceFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where replaceFailure :: ResultList g s a -> ResultList g s a
replaceFailure (ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
f) =
                        BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. BinTree a
EmptyTree (Pos -> String -> ParseFailure Pos s -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s -> ParseFailure Pos s
replaceExpected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
msg ParseFailure Pos 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) = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s ()
forall {s} {g :: (* -> *) -> *} {g :: (* -> *) -> *} {s} {r}.
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 BinTree (ResultInfo g s r)
EmptyTree ParseFailure Pos s
_) = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
t ()) ParseFailure Pos s
forall a. Monoid a => a
mempty
            rewind [(s, g (ResultList g s))]
t ResultList{} = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> 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 = () -> Parser g s ()
forall a. a -> Parser g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Parser g s () -> Parser g s () -> Parser g s ()
forall a. Parser g s a -> Parser g s a -> Parser g s a
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 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 g s ()
go
   unexpected :: forall a. String -> Parser g s a
unexpected String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
t-> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultList g s a)
-> ParseFailure Pos s -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
erroneous (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(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, 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))]
_)
               | s -> Bool
forall m. MonoidNull m => m -> Bool
null s
s = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) ParseFailure Pos s
forall a. Monoid a => a
mempty
               | Bool
otherwise = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"end of input")
            f [] = BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] ()) ParseFailure Pos s
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 = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
r where
      r :: [(s, g (ResultList g s))] -> ResultList g s a
r [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
               of rl :: ResultList g s a
rl@(ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
_failure) -> ResultList g s a
rl ResultList g s a -> ResultList g s a -> ResultList g s a
forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
                  ResultList g s a
rl -> ResultList g s a
rl
   takeSome :: forall a. Parser g s a -> Parser g s [a]
takeSome Parser g s a
p = (:) (a -> [a] -> [a]) -> Parser g s a -> Parser g s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p Parser g s ([a] -> [a]) -> Parser g s [a] -> Parser g s [a]
forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser g s a -> Parser g s [a]
forall a. Parser g s a -> Parser g s [a]
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) = ([(s, g (ResultList g s))] -> ResultList g s [a]) -> Parser g s [a]
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q Int
0 [a] -> [a]
forall a. a -> a
id) where
      q :: Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q Int
len [a] -> [a]
acc [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
                       of ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
_failure -> BinTree (ResultInfo g s [a])
-> ParseFailure Pos s -> ResultList g s [a]
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s [a] -> BinTree (ResultInfo g s [a])
forall a. a -> BinTree a
Leaf (ResultInfo g s [a] -> BinTree (ResultInfo g s [a]))
-> ResultInfo g s [a] -> BinTree (ResultInfo g s [a])
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> [a] -> ResultInfo g s [a]
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
len [(s, g (ResultList g s))]
rest ([a] -> [a]
acc [])) ParseFailure Pos s
forall a. Monoid a => a
mempty
                          ResultList BinTree (ResultInfo g s a)
rl ParseFailure Pos s
_ -> (ResultInfo g s a -> ResultList g s [a])
-> BinTree (ResultInfo g s a) -> ResultList g s [a]
forall m a. Monoid m => (a -> m) -> BinTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo g s a -> ResultList g s [a]
continue BinTree (ResultInfo g s a)
rl
         where continue :: ResultInfo g s a -> ResultList g s [a]
continue (ResultInfo Int
len' [(s, g (ResultList g s))]
rest' a
result) = Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') ([a] -> [a]
acc ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
resulta -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [(s, g (ResultList g s))]
rest'
   skipAll :: forall a. Parser g s a -> Parser g s ()
skipAll (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q Int
0) where
      q :: Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q Int
len [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
                   of ResultList BinTree (ResultInfo g s a)
EmptyTree ParseFailure Pos s
_failure -> BinTree (ResultInfo g s ())
-> ParseFailure Pos s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
len [(s, g (ResultList g s))]
rest ()) ParseFailure Pos s
forall a. Monoid a => a
mempty
                      ResultList BinTree (ResultInfo g s a)
rl ParseFailure Pos s
_failure -> (ResultInfo g s a -> ResultList g s ())
-> BinTree (ResultInfo g s a) -> ResultList g s ()
forall m a. Monoid m => (a -> m) -> BinTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo g s a -> ResultList g s ()
continue BinTree (ResultInfo g s a)
rl
         where continue :: ResultInfo g s a -> ResultList g s ()
continue (ResultInfo Int
len' [(s, g (ResultList g s))]
rest' a
_) = Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') [(s, g (ResultList g s))]
rest'

instance (MonoidNull s, 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) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s a
forall {s} {g :: (* -> *) -> *} {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))]
t (ResultList BinTree (ResultInfo g s r)
rl ParseFailure Pos s
failure) = BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList ([(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
forall {s} {g :: (* -> *) -> *} {g :: (* -> *) -> *} {s} {r}.
[(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
rewindInput [(s, g (ResultList g s))]
t (ResultInfo g s r -> ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rl) ParseFailure Pos s
failure
            rewindInput :: [(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
rewindInput [(s, g (ResultList g s))]
t (ResultInfo Int
_ [(s, g (ResultList g s))]
_ r
r) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
t 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 = ([(s, g (ResultList g s))] -> ResultList g s Char)
-> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s Char
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s Char
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s Char)
-> ParseFailure Pos s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a. a -> BinTree a
Leaf (ResultInfo g s Char -> BinTree (ResultInfo g s Char))
-> ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> Char -> ResultInfo g s Char
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
1 [(s, g (ResultList g s))]
t Char
first) ParseFailure Pos s
forall a. Monoid a => a
mempty
                  Maybe Char
_ -> BinTree (ResultInfo g s Char)
-> ParseFailure Pos s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> Int
forall m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"Char.satisfy")
            p [] = BinTree (ResultInfo g s Char)
-> ParseFailure Pos s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"Char.satisfy")
   string :: String -> Parser g s String
string String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

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 BinTree (ResultInfo g s r)
EmptyTree (ParseFailure Pos
pos FailureDescription s
positive [String]
negative)) =
   ParseFailure Pos s -> Either (ParseFailure Pos s) [(s, r)]
forall a b. a -> Either a b
Left (Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
- Pos
1) FailureDescription s
positive [String]
negative)
fromResultList (ResultList BinTree (ResultInfo g s r)
rl ParseFailure Pos s
_failure) = [(s, r)] -> Either (ParseFailure Pos s) [(s, r)]
forall a b. b -> Either a b
Right (ResultInfo g s r -> (s, r)
forall {a} {g :: (* -> *) -> *} {b}.
Monoid a =>
ResultInfo g a b -> (a, b)
f (ResultInfo g s r -> (s, r)) -> [ResultInfo g s r] -> [(s, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r) -> [ResultInfo g s r]
forall a. BinTree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo g s r)
rl)
   where f :: ResultInfo g a b -> (a, b)
f (ResultInfo Int
_ ((a
s, g (ResultList g a)
_):[(a, g (ResultList g a))]
_) b
r) = (a
s, b
r)
         f (ResultInfo Int
_ [] b
r) = (a
forall a. Monoid a => a
mempty, b
r)

-- | 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 = ([(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a)
-> Parser g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q where
   q :: [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q [(s, g (ResultList g s))]
rest = case Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser Parser g s a
p [(s, g (ResultList g s))]
rest
            of ResultList BinTree (ResultInfo g s a)
EmptyTree (ParseFailure Pos
pos (FailureDescription [String]
static [s]
inputs) [String]
errors)
                  -> ParseFailure Pos [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
Backtrack.NoParse (Pos
-> FailureDescription [(s, g (ResultList g s))]
-> [String]
-> ParseFailure Pos [(s, g (ResultList g s))]
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos ([String]
-> [[(s, g (ResultList g s))]]
-> FailureDescription [(s, g (ResultList g s))]
forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
static ([[(s, g (ResultList g s))]]
 -> FailureDescription [(s, g (ResultList g s))])
-> [[(s, g (ResultList g s))]]
-> FailureDescription [(s, g (ResultList g s))]
forall a b. (a -> b) -> a -> b
$ (s -> [(s, g (ResultList g s))])
-> [s] -> [[(s, g (ResultList g s))]]
forall a b. (a -> b) -> [a] -> [b]
map s -> [(s, g (ResultList g s))]
forall {a} {b}. a -> [(a, b)]
wrap [s]
inputs) [String]
errors)
               ResultList BinTree (ResultInfo g s a)
rs ParseFailure Pos s
_ -> ResultInfo g s a -> Result g [(s, g (ResultList g s))] a
forall {g :: (* -> *) -> *} {s} {v} {g :: (* -> *) -> *}.
ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed ((ResultInfo g s a -> ResultInfo g s a -> Ordering)
-> BinTree (ResultInfo g s a) -> ResultInfo g s a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (ResultInfo g s a -> Int)
-> ResultInfo g s a
-> ResultInfo g s a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ResultInfo g s a -> Int
forall (g :: (* -> *) -> *) s a. ResultInfo g s a -> Int
resultLength) BinTree (ResultInfo g s a)
rs)
   resultLength :: ResultInfo g s r -> Int
resultLength (ResultInfo Int
l [(s, g (ResultList g s))]
_ r
_) = Int
l
   parsed :: ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed (ResultInfo Int
l [(s, g (ResultList g s))]
s 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
   wrap :: a -> [(a, b)]
wrap a
s = [(a
s, String -> b
forall a. HasCallStack => String -> a
error String
"longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
peg :: 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 = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = case Parser g [(s, g (ResultList g s))] a
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultList g s))] a
p [(s, g (ResultList g s))]
rest
            of Backtrack.Parsed Int
l a
result [(s, g (ResultList g s))]
suffix -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
suffix a
result) ParseFailure Pos s
forall a. Monoid a => a
mempty
               Backtrack.NoParse (ParseFailure Pos
pos (FailureDescription [String]
static [[(s, g (ResultList g s))]]
inputs) [String]
errors)
                  -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos ([String] -> [s] -> FailureDescription s
forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
static ((s, g (ResultList g s)) -> s
forall a b. (a, b) -> a
fst ((s, g (ResultList g s)) -> s)
-> ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. HasCallStack => [a] -> a
head ([(s, g (ResultList g s))] -> s)
-> [[(s, g (ResultList g s))]] -> [s]
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 = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList g s a
q [] = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
forall a. Monoid a => a
mempty
            of Backtrack.Parsed Int
l a
result s
_ -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [] a
result) ParseFailure Pos s
forall a. Monoid a => a
mempty
               Backtrack.NoParse ParseFailure Pos s
failure -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty ParseFailure Pos s
failure
   q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
                       of Backtrack.Parsed Int
l a
result s
_ -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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
result) ParseFailure Pos s
forall a. Monoid a => a
mempty
                          Backtrack.NoParse ParseFailure Pos s
failure -> BinTree (ResultInfo g s a)
-> ParseFailure Pos s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure Pos s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty ParseFailure Pos s
failure