{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs, MultiParamTypeClasses,
RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
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)
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 (Down Int) s
f) = String
"ResultList (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows BinTree (ResultInfo g s r)
l (String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows ParseFailure (Down Int) 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 (Down Int) s
f) String
rest = String
"ResultList " forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (forall {g :: (* -> *) -> *} {s} {r}. ResultInfo g s r -> r
simplify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo g s a)
l) (forall a. Show a => a -> ShowS
shows ParseFailure (Down Int) 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 @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ 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) = 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 = forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 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 = forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
l1 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) = forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
t 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 (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList ((a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a)
l) ParseFailure (Down Int) 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 (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f) BinTree (ResultInfo g s a)
l) ParseFailure (Down Int) s
failure
instance Ord s => Semigroup (ResultList g s r) where
ResultList BinTree (ResultInfo g s r)
rl1 ParseFailure (Down Int) s
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList BinTree (ResultInfo g s r)
rl2 ParseFailure (Down Int) s
f2 = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (BinTree (ResultInfo g s r)
rl1 forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo g s r)
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
instance Ord s => Monoid (ResultList g s r) where
mempty :: ResultList g s r
mempty = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
mappend :: ResultList g s r -> ResultList g s r -> ResultList g s r
mappend = 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 (Down Int) s
_) = Bool
False
hasSuccess ResultList g s a
_ = Bool
True
failureOf :: forall s a. ResultList g s a -> ParseFailure (Down Int) s
failureOf (ResultList BinTree (ResultInfo g s a)
_ ParseFailure (Down Int) s
failure) = ParseFailure (Down Int) s
failure
failWith :: forall s a. ParseFailure (Down Int) s -> ResultList g s a
failWith = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. BinTree a
EmptyTree
instance Ord s => Applicative (ResultList g s) where
pure :: forall a. a -> ResultList g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo g s (a -> b))
rl1 ParseFailure (Down Int) 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 (Down Int) s
f2 = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s (a -> b))
rl1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinTree (ResultInfo g s a)
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
instance Ord s => Alternative (ResultList g s) where
empty :: forall a. ResultList g s a
empty = forall a. Monoid a => a
mempty
<|> :: forall 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 (Down Int) s
f1) (ResultList BinTree (ResultInfo g s (Ambiguous a))
rl2 ParseFailure (Down Int) s
f2) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. BinTree a -> BinTree a -> BinTree a
Fork BinTree (ResultInfo g s (Ambiguous a))
rl1 BinTree (ResultInfo g s (Ambiguous a))
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
instance Storable1 (ResultList g s) Bool where
store1 :: forall b. Bool -> ResultList g s b
store1 Bool
bit = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. BinTree a
EmptyTree (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ if Bool
bit then Down Int
1 else Down Int
0)
reuse1 :: forall b. ResultList g s b -> Bool
reuse1 (ResultList BinTree (ResultInfo g s b)
_ (ParseFailure Down Int
pos FailureDescription s
_ [String]
_)) = Down Int
pos forall a. Eq a => a -> a -> Bool
/= Down Int
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 = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s a. Storable s a => a -> s
store ParserFlags g
a) forall a. Monoid a => a
mempty
reuse1 :: forall b. ResultList g s b -> ParserFlags g
reuse1 (ResultList (Leaf ResultInfo g s b
s) ParseFailure (Down Int) s
_) = 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) = 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) (forall s a. Storable s a => a -> s
store Dependencies g
d) (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
_) = forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) (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) = [(forall a. Monoid a => a
mempty, forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
reuse :: [(s, g (ResultList g s))] -> Dependencies g
reuse [] = forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
reuse [(s
_, g (ResultList g s)
deps)] = forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (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) = 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)
{-# INLINABLE 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) 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 BinTree (ResultInfo g s (a -> b))
results ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 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) = 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 (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {t} {r} {g :: (* -> *) -> *} {s}.
Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust Int
l t -> r
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s t)
rs) ParseFailure (Down Int) 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) = forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lforall 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 = forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 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 = 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
{-# 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) = 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
. [(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 = 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 = 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 (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 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) = forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultList g s r -> ResultList g s r
continue' Int
l (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 (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {r}.
Int -> ResultInfo g s r -> ResultInfo g s r
adjust Int
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rs) ParseFailure (Down Int) 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) = forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lforall 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 = 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.
BinTree (ResultInfo 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 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 = 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 :: 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 = 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
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)
d
p [(s, g (ResultList g s))]
_ = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 BinTree (ResultInfo g s a)
EmptyTree 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 BinTree (ResultInfo g s a)
EmptyTree 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 BinTree (ResultInfo g s a)
EmptyTree 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 BinTree (ResultInfo g s a)
EmptyTree 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 (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails 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
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
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)forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsed
where gd :: g (ResultList g s)
gd = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (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 = 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] forall a. Monoid a => a
mempty) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) forall a. Monoid a => a
mempty
Maybe (r, r)
_ -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(r, g (ResultList g r))]
rest) String
"anyToken")
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) forall a. Monoid a => a
mempty
Maybe (s, s)
_ -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfy")
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
prefix) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] forall a. Monoid a => a
mempty) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] forall a. Monoid a => a
mempty) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 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 = 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) ParserInput (Parser g s)
s) forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> 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.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfy")
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) 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) = 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 (Down Int) 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 = forall a. String -> a -> a
trace (String
prefix forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
1 [(s, g (ResultList g s))]
t forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> m
Factorial.primePrefix s
s) forall a. Monoid a => a
mempty
Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"satisfyCharInput")
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
prefix) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] forall a. Monoid a => a
mempty) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) forall a. Monoid a => a
mempty
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] forall a. Monoid a => a
mempty) 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) forall a. Monoid a => a
mempty
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> 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.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"notSatisfyChar")
p [(s, g (ResultList g s))]
rest = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) 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) = 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 (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList BinTree (ResultInfo 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 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 = 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 (Down Int) s
f) =
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. BinTree a
EmptyTree (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 m. Factorial m => m -> 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 BinTree (ResultInfo g s r)
EmptyTree ParseFailure (Down Int) s
_) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
t ()) forall a. Monoid a => a
mempty
rewind [(s, g (ResultList g s))]
t ResultList{} = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure () forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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.
BinTree (ResultInfo 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 m. Factorial m => m -> 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
rest ()) forall a. Monoid a => a
mempty
| Bool
otherwise = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"end of input")
f [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [] ()) 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 BinTree (ResultInfo g s a)
EmptyTree 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 BinTree (ResultInfo g s a)
EmptyTree ParseFailure (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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 [])) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo g s a)
rl ParseFailure (Down Int) s
_ -> 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 forall a. Num a => a -> a -> a
+ Int
len') ([a] -> [a]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
resultforall 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) = 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 (Down Int) s
_failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
len [(s, g (ResultList g s))]
rest ()) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo g s a)
rl ParseFailure (Down Int) s
_failure -> 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 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 :: (* -> *) -> *} {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 (Down Int) s
failure) = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rl) ParseFailure (Down Int) 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) = 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 = 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) forall a. Monoid a => a
mempty
Maybe Char
_ -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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 m. Factorial m => m -> Int
length [(s, g (ResultList g s))]
rest) String
"Char.satisfy")
p [] = forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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)
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 Down Int
pos FailureDescription s
positive [String]
negative)) =
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
positive [String]
negative)
fromResultList (ResultList BinTree (ResultInfo g s r)
rl ParseFailure (Down Int) s
_failure) = forall a b. b -> Either a b
Right (forall {a} {g :: (* -> *) -> *} {b}.
Monoid a =>
ResultInfo g a b -> (a, b)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = (forall a. Monoid a => a
mempty, b
r)
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 BinTree (ResultInfo g s a)
EmptyTree (ParseFailure Down Int
pos (FailureDescription [String]
expected [s]
inputs) [String]
errors)
-> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
Backtrack.NoParse (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. a -> [(a, b)]
wrap [s]
inputs) [String]
errors)
ResultList BinTree (ResultInfo g s a)
rs ParseFailure (Down Int) s
_ -> forall {g :: (* -> *) -> *} {s} {v} {g :: (* -> *) -> *}.
ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed (forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` 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) = 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ 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) forall a. Monoid a => a
mempty
Backtrack.NoParse (ParseFailure Down Int
pos (FailureDescription [String]
expected [[(s, g (ResultList g s))]]
inputs) [String]
errors)
-> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Down Int
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
expected (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(s, g (ResultList g s))]]
inputs)) [String]
errors)
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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [] a
result) forall a. Monoid a => a
mempty
Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo 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.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) a
result) forall a. Monoid a => a
mempty
Backtrack.NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r)
-> ParseFailure (Down Int) s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure