{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Text.Grampa.ContextFree.SortedMemoizing
(ParseFailure(..), ResultList(..), Parser(..),
longest, peg, terminalPEG)
where
import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
#if MIN_VERSION_base(4,13,0)
import Control.Monad (MonadFail(fail))
#endif
import Data.Either (partitionEithers)
import Data.Functor.Compose (Compose(..))
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty, toList)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid, splitPrimePrefix)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.Ord (Down(Down))
import Data.Semigroup (Semigroup((<>)))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)
import Debug.Trace (trace)
import Witherable (Filterable(mapMaybe))
import qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.Input.Position (fromEnd)
import Text.Parser.LookAhead (LookAheadParsing(..))
import qualified Rank2
import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
AmbiguousParsing(..), Ambiguous(Ambiguous), CommittedParsing(..),
ConsumedInputParsing(..), DeterministicParsing(..),
TailsParsing(parseTails, parseAllTails), ParseResults, ParseFailure(..),
FailureDescription(..))
import Text.Grampa.Internal (ResultList(..), ResultsOfLength(..), TraceableParsing(..),
emptyFailure, expected, expectedInput, replaceExpected, erroneous)
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack
import Prelude hiding (iterate, null, showList, span, takeWhile)
newtype Parser g s r = Parser{forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser :: [(s, g (ResultList g s))] -> ResultList g s r}
instance Functor (Parser g i) where
fmap :: forall a b. (a -> b) -> Parser g i a -> Parser g i b
fmap a -> b
f (Parser [(i, g (ResultList g i))] -> ResultList g i a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, g (ResultList g i))] -> ResultList g i a
p)
{-# INLINE fmap #-}
instance Ord s => Applicative (Parser g s) where
pure :: forall a. a -> Parser g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
rest-> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (a
aforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty)
Parser [(s, g (ResultList g s))] -> ResultList g s (a -> b)
p <*> :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser [(s, g (ResultList g s))] -> ResultList g s a
q = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s b
r where
r :: [(s, g (ResultList g s))] -> ResultList g s b
r [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s (a -> b)
p [(s, g (ResultList g s))]
rest
of ResultList [ResultsOfLength g s (a -> b)]
results ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g s (a -> b) -> ResultList g s b
continue [ResultsOfLength g s (a -> b)]
results
continue :: ResultsOfLength g s (a -> b) -> ResultList g s b
continue (ResultsOfLength Int
l [(s, g (ResultList g s))]
rest' NonEmpty (a -> b)
fs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {g :: (* -> *) -> *} {s} {a} {r}.
Int -> ResultList g s a -> (a -> r) -> ResultList g s r
continue' Int
l forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest') NonEmpty (a -> b)
fs
continue' :: Int -> ResultList g s a -> (a -> r) -> ResultList g s r
continue' Int
l (ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
failure) a -> r
f = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {a} {r} {g :: (* -> *) -> *} {s}.
Int -> (a -> r) -> ResultsOfLength g s a -> ResultsOfLength g s r
adjust Int
l a -> r
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) ParseFailure (Down Int) s
failure
adjust :: Int -> (a -> r) -> ResultsOfLength g s a -> ResultsOfLength g s r
adjust Int
l a -> r
f (ResultsOfLength Int
l' [(s, g (ResultList g s))]
rest' NonEmpty a
as) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (Int
lforall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' (a -> r
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
as)
{-# INLINABLE pure #-}
{-# INLINABLE (<*>) #-}
instance Ord s => Alternative (Parser g s) where
empty :: forall a. Parser g s a
empty = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
Parser [(s, g (ResultList g s))] -> ResultList g s a
p <|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<|> Parser [(s, g (ResultList g s))] -> ResultList g s a
q = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
r where
r :: [(s, g (ResultList g s))] -> ResultList g s a
r [(s, g (ResultList g s))]
rest = [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
{-# INLINE (<|>) #-}
{-# INLINABLE empty #-}
instance Filterable (Parser g s) where
mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultList g s))] -> ResultList g s a
p)
instance Ord s => Monad (Parser g s) where
return :: forall a. a -> Parser g s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: forall a b. Parser g s a -> Parser g s b -> Parser g s b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
Parser [(s, g (ResultList g s))] -> ResultList g s a
p >>= :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s b
q where
q :: [(s, g (ResultList g s))] -> ResultList g s b
q [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of ResultList [ResultsOfLength g s a]
results ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g s a -> ResultList g s b
continue [ResultsOfLength g s a]
results
continue :: ResultsOfLength g s a -> ResultList g s b
continue (ResultsOfLength Int
l [(s, g (ResultList g s))]
rest' NonEmpty a
rs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultList g s r -> ResultList g s r
continue' Int
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser [(s, g (ResultList g s))]
rest' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser g s b
f) NonEmpty a
rs
continue' :: Int -> ResultList g s r -> ResultList g s r
continue' Int
l (ResultList [ResultsOfLength g s r]
rs ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust Int
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s r]
rs) ParseFailure (Down Int) s
failure
adjust :: Int -> ResultsOfLength g s r -> ResultsOfLength g s r
adjust Int
l (ResultsOfLength Int
l' [(s, g (ResultList g s))]
rest' NonEmpty r
rs) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (Int
lforall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' NonEmpty r
rs
#if MIN_VERSION_base(4,13,0)
instance Ord s => MonadFail (Parser g s) where
#endif
fail :: forall a. String -> Parser g s a
fail String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p
where p :: [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
msg)
instance Ord s => MonadPlus (Parser g s) where
mzero :: forall a. Parser g s a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. Parser g s a -> Parser g s a -> Parser g s a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance (Semigroup x, Ord s) => Semigroup (Parser g s x) where
<> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
instance (Monoid x, Ord s) => Monoid (Parser g s x) where
mempty :: Parser g s x
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance (Ord s, LeftReductive s, FactorialMonoid s) => GrammarParsing (Parser g s) where
type ParserGrammar (Parser g s) = g
type GrammarFunctor (Parser g s) = ResultList g s
parsingResult :: forall a.
ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult ParserInput (Parser g s)
_ = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList
nonTerminal :: (Rank2.Functor g, ParserInput (Parser g s) ~ s) => (g (ResultList g s) -> ResultList g s a) -> Parser g s a
nonTerminal :: forall a.
(Functor g, ParserInput (Parser g s) ~ s) =>
(g (ResultList g s) -> ResultList g s a) -> Parser g s a
nonTerminal g (ResultList g s) -> ResultList g s a
f = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p where
p :: [(s, g (ResultList g s))] -> ResultList g s a
p input :: [(s, g (ResultList g s))]
input@((s
_, g (ResultList g s)
d) : [(s, g (ResultList g s))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [ResultsOfLength g s a]
rs' ParseFailure (Down Int) s
failure
where ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
failure = g (ResultList g s) -> ResultList g s a
f g (ResultList g s)
d
rs' :: [ResultsOfLength g s a]
rs' = ResultsOfLength g s a -> ResultsOfLength g s a
sync forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs
sync :: ResultsOfLength g s a -> ResultsOfLength g s a
sync (ResultsOfLength Int
0 [(s, g (ResultList g s))]
_remainder NonEmpty a
r) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
input NonEmpty a
r
sync ResultsOfLength g s a
rol = ResultsOfLength g s a
rol
p [(s, g (ResultList g s))]
_ = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"NonTerminal at endOfInput")
{-# INLINE nonTerminal #-}
chainRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultList g s))] -> ResultList g s a
base) (Parser [(s, g (ResultList g s))] -> ResultList g s a
recurse) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g f)] -> ResultList g s a
q
where q :: [(s, g f)] -> ResultList g s a
q [] = [(s, g (ResultList g s))] -> ResultList g s a
base []
q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultList g s))] -> ResultList g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
of r :: ResultList g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultList g s a
r
ResultList g s a
r -> ResultList g s a -> ResultList g s a -> ResultList g s a
iter ResultList g s a
r ResultList g s a
r
where iter :: ResultList g s a -> ResultList g s a -> ResultList g s a
iter f a
marginal ResultList g s a
total = case [(s, g (ResultList g s))] -> ResultList g s a
recurse ((s
s, f a -> g f -> g f
assign f a
marginal g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
of ResultList [] ParseFailure (Down Int) s
_ -> ResultList g s a
total
ResultList g s a
r -> ResultList g s a -> ResultList g s a -> ResultList g s a
iter ResultList g s a
r (ResultList g s a
total forall a. Semigroup a => a -> a -> a
<> ResultList g s a
r)
chainLongestRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainLongestRecursive f a -> g f -> g f
assign (Parser [(s, g (ResultList g s))] -> ResultList g s a
base) (Parser [(s, g (ResultList g s))] -> ResultList g s a
recurse) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g f)] -> ResultList g s a
q
where q :: [(s, g f)] -> ResultList g s a
q [] = [(s, g (ResultList g s))] -> ResultList g s a
base []
q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (ResultList g s))] -> ResultList g s a
base ((s
s, f a -> g f -> g f
assign forall a. Monoid a => a
mempty g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
of r :: ResultList g s a
r@(ResultList [] ParseFailure (Down Int) s
_) -> ResultList g s a
r
ResultList g s a
r -> ResultList g s a -> f a
iter ResultList g s a
r
where iter :: ResultList g s a -> f a
iter f a
r = case [(s, g (ResultList g s))] -> ResultList g s a
recurse ((s
s, f a -> g f -> g f
assign f a
r g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
of ResultList [] ParseFailure (Down Int) s
_ -> f a
r
ResultList g s a
r' -> ResultList g s a -> f a
iter ResultList g s a
r'
instance (Ord s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
parseTails :: forall (g :: (* -> *) -> *) r.
GrammarConstraint (Parser g s) g =>
Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser
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) []
parsePrefix :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
Eq s, FactorialMonoid s) =>
g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g s
input)
parseComplete :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
Eq s, FactorialMonoid s) =>
g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList)
(forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(TailsParsing m, GrammarConstraint m g, Functor g) =>
g m
-> [(ParserInput m, g (GrammarFunctor m))]
-> [(ParserInput m, g (GrammarFunctor m))]
parseAllTails g (Parser g s)
close forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g s
input)
where close :: g (Parser g s)
close = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
eof) g (Parser g s)
g
fromResultList :: FactorialMonoid s => ResultList g s r -> ParseResults s [(s, r)]
fromResultList :: forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
ResultList g s r -> ParseResults s [(s, r)]
fromResultList (ResultList [] (ParseFailure Down Int
pos FailureDescription s
expected' [String]
erroneous')) =
forall a b. a -> Either a b
Left (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Down Int
pos forall a. Num a => a -> a -> a
- Down Int
1) FailureDescription s
expected' [String]
erroneous')
fromResultList (ResultList [ResultsOfLength g s r]
rl ParseFailure (Down Int) s
_failure) = forall a b. b -> Either a b
Right (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {g :: (* -> *) -> *} {a}.
Monoid a =>
ResultsOfLength g a a -> [(a, a)]
f [ResultsOfLength g s r]
rl)
where f :: ResultsOfLength g a a -> [(a, a)]
f (ResultsOfLength Int
_ ((a
s, g (ResultList g a)
_):[(a, g (ResultList g a))]
_) NonEmpty a
r) = (,) a
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty a
r
f (ResultsOfLength Int
_ [] NonEmpty a
r) = (,) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList NonEmpty a
r
parseGrammarTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails :: forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails g (Parser g s)
g s
input = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail [] (forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
where parseTail :: s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail s
s [(s, g (ResultList g s))]
parsedTail = [(s, g (ResultList g s))]
parsed
where parsed :: [(s, g (ResultList g s))]
parsed = (s
s,g (ResultList g s)
d)forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsedTail
d :: g (ResultList g s)
d = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))]
parsed) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser) g (Parser g s)
g
instance (LeftReductive s, FactorialMonoid s, Ord s) => InputParsing (Parser g s) where
type ParserInput (Parser g s) = s
getInput :: Parser g s (ParserInput (Parser g s))
getInput = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {r} {g :: (* -> *) -> *}.
(Ord r, Monoid r) =>
[(r, g (ResultList g r))] -> ResultList g r r
p
where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((r
s, g (ResultList g r)
_):[(r, g (ResultList g r))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(r, g (ResultList g r))]
rest (r
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {r} {g :: (* -> *) -> *}.
(FactorialMonoid r, Ord r) =>
[(r, g (ResultList g r))] -> ResultList g r r
p
where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((r
s, g (ResultList g r)
_):[(r, g (ResultList g r))]
t) = case forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
of Just (r
first, r
_) -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(r, g (ResultList g r))]
t (r
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Maybe (r, r)
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(r, g (ResultList g r))]
rest) String
"anyToken")
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"anyToken")
satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
case forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
of Just (s
first, s
_) | ParserInput (Parser g s) -> Bool
predicate s
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (s
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Maybe (s, s)
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfy")
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfy")
scan :: forall state.
state
-> (state -> ParserInput (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan state
s0 state -> ParserInput (Parser g s) -> Maybe state
f = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
where (s
prefix, s
_, state
_) = forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> ParserInput (Parser g s) -> Maybe state
f s
i
l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length s
prefix
p state
_ [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
0 = forall a. Monoid a => a
mempty
take Int
n = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| s
x <- forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Eq a => a -> a -> Bool
== Int
n =
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| s
x <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| s
x <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"takeWhile1")
string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p where
p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s', g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| ParserInput (Parser g s)
s forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) (ParserInput (Parser g s)
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> s -> ParseFailure (Down Int) s
expectedInput (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) ParserInput (Parser g s)
s)
l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length ParserInput (Parser g s)
s
notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
| Just (s
first, s
_) <- forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s,
ParserInput (Parser g s) -> Bool
predicate s
first = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfy")
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
{-# INLINABLE string #-}
instance (InputParsing (Parser g s), FactorialMonoid s) => TraceableParsing (Parser g s) where
traceInput :: forall a.
(ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case forall a. String -> a -> a
trace (String
"Parsing " forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
s) ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest) of
rl :: ResultList g s a
rl@(ResultList [] ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Failed " forall a. Semigroup a => a -> a -> a
<> (s -> s) -> String
descriptionWith forall a. a -> a
id) ResultList g s a
rl
rl :: ResultList g s a
rl@(ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Parsed [" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ResultsOfLength g s a -> String
describeResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) forall a. Semigroup a => a -> a -> a
<> String
"]") ResultList g s a
rl
where describeResult :: ResultsOfLength g s a -> String
describeResult (ResultsOfLength Int
len [(s, g (ResultList g s))]
_ NonEmpty a
_) = (s -> s) -> String
descriptionWith (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
len)
descriptionWith :: (s -> s) -> String
descriptionWith s -> s
f = ParserInput (Parser g s) -> String
description (s -> s
f s
s)
q [] = [(s, g (ResultList g s))] -> ResultList g s a
p []
instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
case forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (forall m. Factorial m => m -> m
Factorial.primePrefix s
sforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfyCharInput")
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfyCharInput")
scanChars :: forall state.
state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
prefixforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
where (s
prefix, s
_, state
_) = forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
l :: Int
l = forall m. Factorial m => m -> Int
Factorial.length s
prefix
p state
_ [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| s
x <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x =
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (forall a. Monoid a => a
memptyforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
| s
x <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l forall a. Ord a => a -> a -> Bool
> Int
0 =
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (s
xforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"takeCharsWhile1")
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
| Just Char
first <- forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s,
Char -> Bool
predicate Char
first = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfyChar")
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
instance (LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (Parser g s) where
match :: forall a. Parser g s a -> Parser g s (ParserInput (Parser g s), a)
match (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s (s, a)
q
where q :: [(s, g (ResultList g s))] -> ResultList g s (s, a)
q [] = forall {a} {g :: (* -> *) -> *} {s} {a}.
FactorialMonoid a =>
a -> ResultList g s a -> ResultList g s (a, a)
addConsumed forall a. Monoid a => a
mempty ([(s, g (ResultList g s))] -> ResultList g s a
p [])
q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = forall {a} {g :: (* -> *) -> *} {s} {a}.
FactorialMonoid a =>
a -> ResultList g s a -> ResultList g s (a, a)
addConsumed s
s ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
addConsumed :: a -> ResultList g s a -> ResultList g s (a, a)
addConsumed a
input (ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (ResultsOfLength g s a -> ResultsOfLength g s (a, a)
add1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rl) ParseFailure (Down Int) s
failure
where add1 :: ResultsOfLength g s a -> ResultsOfLength g s (a, a)
add1 (ResultsOfLength Int
l [(s, g (ResultList g s))]
t NonEmpty a
rs) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
t ((,) (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
l a
input) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
rs)
instance (MonoidNull s, Ord s) => Parsing (Parser g s) where
try :: forall a. Parser g s a -> Parser g s a
try (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
rewindFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
where rewindFailure :: ResultList g s a -> ResultList g s a
rewindFailure (ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [ResultsOfLength g s a]
rl (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest)
Parser [(s, g (ResultList g s))] -> ResultList g s a
p <?> :: forall a. Parser g s a -> String -> Parser g s a
<?> String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
replaceFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
where replaceFailure :: ResultList g s a -> ResultList g s a
replaceFailure (ResultList [] ParseFailure (Down Int) s
f) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] (forall s.
Down Int
-> String -> ParseFailure (Down Int) s -> ParseFailure (Down Int) s
replaceExpected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
msg ParseFailure (Down Int) s
f)
replaceFailure ResultList g s a
rl = ResultList g s a
rl
notFollowedBy :: forall a. Show a => Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> forall {s} {g :: (* -> *) -> *} {g :: (* -> *) -> *} {s} {r}.
Ord s =>
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
t (ResultList [] ParseFailure (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
t (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
rewind [(s, g (ResultList g s))]
t ResultList{} = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
t) String
"notFollowedBy")
skipMany :: forall a. Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
where go :: Parser g s ()
go = forall (f :: * -> *) a. Applicative f => a -> f a
pure () forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser g s a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
unexpected :: forall a. String -> Parser g s a
unexpected String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
t-> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
t) String
msg)
eof :: Parser g s ()
eof = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser forall {s} {g :: (* -> *) -> *}.
(MonoidNull s, Ord s) =>
[(s, g (ResultList g s))] -> ResultList g s ()
f
where f :: [(s, g (ResultList g s))] -> ResultList g s ()
f rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
| forall m. MonoidNull m => m -> Bool
null s
s = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
| Bool
otherwise = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"end of input")
f [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [] (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
instance (MonoidNull s, Ord s) => DeterministicParsing (Parser g s) where
Parser [(s, g (ResultList g s))] -> ResultList g s a
p <<|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser [(s, g (ResultList g s))] -> ResultList g s a
q = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
r where
r :: [(s, g (ResultList g s))] -> ResultList g s a
r [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of rl :: ResultList g s a
rl@(ResultList [] ParseFailure (Down Int) s
_failure) -> ResultList g s a
rl forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
ResultList g s a
rl -> ResultList g s a
rl
takeSome :: forall a. Parser g s a -> Parser g s [a]
takeSome Parser g s a
p = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany Parser g s a
p
takeMany :: forall a. Parser g s a -> Parser g s [a]
takeMany (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q Int
0 forall a. a -> a
id) where
q :: Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q !Int
len [a] -> [a]
acc [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of ResultList [] ParseFailure (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
len [(s, g (ResultList g s))]
rest ([a] -> [a]
acc [] forall a. a -> [a] -> NonEmpty a
:| [])] forall a. Monoid a => a
mempty
ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g s a -> ResultList g s [a]
continue [ResultsOfLength g s a]
rl
where continue :: ResultsOfLength g s a -> ResultList g s [a]
continue (ResultsOfLength Int
len' [(s, g (ResultList g s))]
rest' NonEmpty a
results) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
r-> Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q (Int
len forall a. Num a => a -> a -> a
+ Int
len') ([a] -> [a]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
rforall a. a -> [a] -> [a]
:)) [(s, g (ResultList g s))]
rest') NonEmpty a
results
skipAll :: forall a. Parser g s a -> Parser g s ()
skipAll (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q Int
0) where
q :: Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q !Int
len [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of ResultList [] ParseFailure (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
len [(s, g (ResultList g s))]
rest (()forall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
_failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultsOfLength g s a -> ResultList g s ()
continue [ResultsOfLength g s a]
rl
where continue :: ResultsOfLength g s a -> ResultList g s ()
continue (ResultsOfLength Int
len' [(s, g (ResultList g s))]
rest' NonEmpty a
_) = Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q (Int
len forall a. Num a => a -> a -> a
+ Int
len') [(s, g (ResultList g s))]
rest'
instance (MonoidNull s, Ord s) => LookAheadParsing (Parser g s) where
lookAhead :: forall a. Parser g s a -> Parser g s a
lookAhead (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> forall {s} {g :: (* -> *) -> *} {r}.
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s r
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s r
rewind [(s, g (ResultList g s))]
_ rl :: ResultList g s r
rl@(ResultList [] ParseFailure (Down Int) s
_) = ResultList g s r
rl
rewind [(s, g (ResultList g s))]
t (ResultList [ResultsOfLength g s r]
rl ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
t forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Semigroup a => a -> a -> a
(<>) (forall {g :: (* -> *) -> *} {s} {r}.
ResultsOfLength g s r -> NonEmpty r
results forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s r]
rl)] ParseFailure (Down Int) s
failure
results :: ResultsOfLength g s r -> NonEmpty r
results (ResultsOfLength Int
_ [(s, g (ResultList g s))]
_ NonEmpty r
r) = NonEmpty r
r
instance (Ord s, Show s, TextualMonoid s) => CharParsing (Parser g s) where
satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s Char
p
where p :: [(s, g (ResultList g s))] -> ResultList g s Char
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
case forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
1 [(s, g (ResultList g s))]
t (Char
firstforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (ResultList g s))]
rest) String
"Char.satisfy")
p [] = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"Char.satisfy")
string :: String -> Parser g s String
string String
s = forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall a. IsString a => String -> a
fromString String
s)
text :: Text -> Parser g s Text
text Text
t = (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)
instance Ord s => AmbiguousParsing (Parser g s) where
ambiguous :: forall a. Parser g s a -> Parser g s (Ambiguous a)
ambiguous (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s (Ambiguous a)
q
where q :: [(s, g (ResultList g s))] -> ResultList g s (Ambiguous a)
q [(s, g (ResultList g s))]
rest | ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
failure <- [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {a}.
ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rs) ParseFailure (Down Int) s
failure
groupByLength :: ResultsOfLength g s a -> ResultsOfLength g s (Ambiguous a)
groupByLength (ResultsOfLength Int
l [(s, g (ResultList g s))]
rest NonEmpty a
rs) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
rest (forall a. NonEmpty a -> Ambiguous a
Ambiguous NonEmpty a
rs forall a. a -> [a] -> NonEmpty a
:| [])
instance Ord s => CommittedParsing (Parser g s) where
type CommittedResults (Parser g s) = ParseResults s
commit :: forall a.
Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))]
-> ResultList g s (Either (ParseFailure (Down Int) s) a)
q
where q :: [(s, g (ResultList g s))]
-> ResultList g s (Either (ParseFailure (Down Int) s) a)
q [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of ResultList [] ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 [(s, g (ResultList g s))]
rest (forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failureforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
ResultList [ResultsOfLength g s a]
rl ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
rl) ParseFailure (Down Int) s
failure
admit :: forall a.
Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser [(s, g (ResultList g s))]
-> ResultList g s (CommittedResults (Parser g s) a)
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))]
-> ResultList g s (CommittedResults (Parser g s) a)
p [(s, g (ResultList g s))]
rest
of ResultList [] ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] ParseFailure (Down Int) s
failure
ResultList [ResultsOfLength g s (CommittedResults (Parser g s) a)]
rl ParseFailure (Down Int) s
failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {s} {g :: (* -> *) -> *} {r}.
Ord s =>
ResultsOfLength g s (Either (ParseFailure (Down Int) s) r)
-> ResultList g s r
expose [ResultsOfLength g s (CommittedResults (Parser g s) a)]
rl forall a. Semigroup a => a -> a -> a
<> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] ParseFailure (Down Int) s
failure
expose :: ResultsOfLength g s (Either (ParseFailure (Down Int) s) r)
-> ResultList g s r
expose (ResultsOfLength Int
len [(s, g (ResultList g s))]
t NonEmpty (Either (ParseFailure (Down Int) s) r)
rs) = case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [r]
successes of
Maybe (NonEmpty r)
Nothing -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
Just NonEmpty r
successes' -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
len [(s, g (ResultList g s))]
t NonEmpty r
successes'] (forall a. Monoid a => [a] -> a
mconcat [ParseFailure (Down Int) s]
failures)
where ([ParseFailure (Down Int) s]
failures, [r]
successes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a. NonEmpty a -> [a]
toList NonEmpty (Either (ParseFailure (Down Int) s) r)
rs)
longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: forall (g :: (* -> *) -> *) s a.
Parser g s a -> Parser g [(s, g (ResultList g s))] a
longest Parser g s a
p = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q where
q :: [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q [(s, g (ResultList g s))]
rest = case forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser Parser g s a
p [(s, g (ResultList g s))]
rest
of ResultList [] (ParseFailure Down Int
pos (FailureDescription [String]
static [s]
inputs) [String]
errors)
-> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
Backtrack.NoParse (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
static forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. a -> [(a, b)]
wrap [s]
inputs) [String]
errors)
ResultList [ResultsOfLength g s a]
rs ParseFailure (Down Int) s
_ -> forall {g :: (* -> *) -> *} {s} {v} {g :: (* -> *) -> *}.
ResultsOfLength g s v -> Result g [(s, g (ResultList g s))] v
parsed (forall a. [a] -> a
last [ResultsOfLength g s a]
rs)
parsed :: ResultsOfLength g s v -> Result g [(s, g (ResultList g s))] v
parsed (ResultsOfLength Int
l [(s, g (ResultList g s))]
s (v
r:|[v]
_)) = forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultList g s))]
s
wrap :: a -> [(a, b)]
wrap a
s = [(a
s, forall a. HasCallStack => String -> a
error String
"longest")]
peg :: Ord s => Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg :: forall s (g :: (* -> *) -> *) a.
Ord s =>
Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg Parser g [(s, g (ResultList g s))] a
p = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultList g s))] a
p [(s, g (ResultList g s))]
rest
of Backtrack.Parsed Int
l a
result [(s, g (ResultList g s))]
suffix -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
suffix (a
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Backtrack.NoParse (ParseFailure Down Int
pos (FailureDescription [String]
static [[(s, g (ResultList g s))]]
inputs) [String]
errors)
-> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
static (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(s, g (ResultList g s))]]
inputs)) [String]
errors)
terminalPEG :: Monoid s => Ord s => Backtrack.Parser g s a -> Parser g s a
terminalPEG :: forall s (g :: (* -> *) -> *) a.
(Monoid s, Ord s) =>
Parser g s a -> Parser g s a
terminalPEG Parser g s a
p = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
q :: [(s, g (ResultList g s))] -> ResultList g s a
q [] = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p forall a. Monoid a => a
mempty
of Backtrack.Parsed Int
l a
result s
_ -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [] (a
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure
q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
of Backtrack.Parsed Int
l a
result s
_ ->
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList [forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) (a
resultforall a. a -> [a] -> NonEmpty a
:|[])] forall a. Monoid a => a
mempty
Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r]
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure