{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.Memoizing (FailureInfo(..), ResultList(..), Parser(..), BinTree(..), (<<|>),
fromResultList, reparseTails, longest, peg, terminalPEG)
where
import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
import Data.Function (on)
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (genericLength, maximumBy, nub)
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Cancellative (isPrefixOf)
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid, length, splitPrimePrefix)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.String (fromString)
import qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.LookAhead (LookAheadParsing(..))
import Text.Parser.Token (TokenParsing)
import qualified Text.Parser.Token
import qualified Rank2
import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..),
ParseResults, ParseFailure(..))
import Text.Grampa.Internal (BinTree(..), FailureInfo(..))
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack
import Prelude hiding (iterate, length, null, showList, span, takeWhile)
newtype Parser g s r = Parser{Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser :: [(s, g (ResultList g s))] -> ResultList g s r}
data ResultList g s r = ResultList !(BinTree (ResultInfo g s r)) {-# UNPACK #-} !FailureInfo
data ResultInfo g s r = ResultInfo !Int ![(s, g (ResultList g s))] !r
instance Show r => Show (ResultList g s r) where
show :: ResultList g s r -> String
show (ResultList l :: BinTree (ResultInfo g s r)
l f :: FailureInfo
f) = "ResultList (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinTree (ResultInfo g s r) -> ShowS
forall a. Show a => a -> ShowS
shows BinTree (ResultInfo g s r)
l (") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo
f ")")
instance Show1 (ResultList g s) where
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList g s a -> ShowS
liftShowsPrec _sp :: Int -> a -> ShowS
_sp showList :: [a] -> ShowS
showList _prec :: Int
_prec (ResultList l :: BinTree (ResultInfo g s a)
l f :: FailureInfo
f) rest :: String
rest = "ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (ResultInfo g s a -> a
forall (g :: (* -> *) -> *) s r. ResultInfo g s r -> r
simplify (ResultInfo g s a -> a) -> [ResultInfo g s a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a) -> [ResultInfo g s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo g s a)
l) (FailureInfo -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo
f String
rest)
where simplify :: ResultInfo g s r -> r
simplify (ResultInfo _ _ r :: r
r) = r
r
instance Show r => Show (ResultInfo g s r) where
show :: ResultInfo g s r -> String
show (ResultInfo l :: Int
l _ r :: r
r) = "(ResultInfo @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> ShowS
forall a. Show a => a -> ShowS
shows r
r ")"
instance Functor (ResultInfo g s) where
fmap :: (a -> b) -> ResultInfo g s a -> ResultInfo g s b
fmap f :: a -> b
f (ResultInfo l :: Int
l t :: [(s, g (ResultList g s))]
t r :: a
r) = Int -> [(s, g (ResultList g s))] -> b -> ResultInfo g s b
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
t (a -> b
f a
r)
instance Functor (ResultList g s) where
fmap :: (a -> b) -> ResultList g s a -> ResultList g s b
fmap f :: a -> b
f (ResultList l :: BinTree (ResultInfo g s a)
l failure :: FailureInfo
failure) = BinTree (ResultInfo g s b) -> FailureInfo -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList ((a -> b
f (a -> b) -> ResultInfo g s a -> ResultInfo g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo g s a -> ResultInfo g s b)
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a)
l) FailureInfo
failure
instance Semigroup (ResultList g s r) where
ResultList rl1 :: BinTree (ResultInfo g s r)
rl1 f1 :: FailureInfo
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList rl2 :: BinTree (ResultInfo g s r)
rl2 f2 :: FailureInfo
f2 = BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (BinTree (ResultInfo g s r)
rl1 BinTree (ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo g s r)
rl2) (FailureInfo
f1 FailureInfo -> FailureInfo -> FailureInfo
forall a. Semigroup a => a -> a -> a
<> FailureInfo
f2)
instance Monoid (ResultList g s r) where
mempty :: ResultList g s r
mempty = BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s r)
forall a. Monoid a => a
mempty FailureInfo
forall a. Monoid a => a
mempty
mappend :: ResultList g s r -> ResultList g s r -> ResultList g s r
mappend = ResultList g s r -> ResultList g s r -> ResultList g s r
forall a. Semigroup a => a -> a -> a
(<>)
instance Functor (Parser g i) where
fmap :: (a -> b) -> Parser g i a -> Parser g i b
fmap f :: a -> b
f (Parser p :: [(i, g (ResultList g i))] -> ResultList g i a
p) = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser ((a -> b) -> ResultList g i a -> ResultList g i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ResultList g i a -> ResultList g i b)
-> ([(i, g (ResultList g i))] -> ResultList g i a)
-> [(i, g (ResultList g i))]
-> ResultList g i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, g (ResultList g i))] -> ResultList g i a
p)
{-# INLINABLE fmap #-}
instance Applicative (Parser g i) where
pure :: a -> Parser g i a
pure a :: a
a = ([(i, g (ResultList g i))] -> ResultList g i a) -> Parser g i a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\rest :: [(i, g (ResultList g i))]
rest-> BinTree (ResultInfo g i a) -> FailureInfo -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g i a -> BinTree (ResultInfo g i a)
forall a. a -> BinTree a
Leaf (ResultInfo g i a -> BinTree (ResultInfo g i a))
-> ResultInfo g i a -> BinTree (ResultInfo g i a)
forall a b. (a -> b) -> a -> b
$ Int -> [(i, g (ResultList g i))] -> a -> ResultInfo g i a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(i, g (ResultList g i))]
rest a
a) FailureInfo
forall a. Monoid a => a
mempty)
Parser p :: [(i, g (ResultList g i))] -> ResultList g i (a -> b)
p <*> :: Parser g i (a -> b) -> Parser g i a -> Parser g i b
<*> Parser q :: [(i, g (ResultList g i))] -> ResultList g i a
q = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(i, g (ResultList g i))] -> ResultList g i b
r where
r :: [(i, g (ResultList g i))] -> ResultList g i b
r rest :: [(i, g (ResultList g i))]
rest = case [(i, g (ResultList g i))] -> ResultList g i (a -> b)
p [(i, g (ResultList g i))]
rest
of ResultList results :: BinTree (ResultInfo g i (a -> b))
results failure :: FailureInfo
failure -> BinTree (ResultInfo g i b) -> FailureInfo -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g i b)
forall a. Monoid a => a
mempty FailureInfo
failure ResultList g i b -> ResultList g i b -> ResultList g i b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo g i (a -> b) -> ResultList g i b)
-> BinTree (ResultInfo g i (a -> b)) -> ResultList g i b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo g i (a -> b) -> ResultList g i b
continue BinTree (ResultInfo g i (a -> b))
results
continue :: ResultInfo g i (a -> b) -> ResultList g i b
continue (ResultInfo l :: Int
l rest' :: [(i, g (ResultList g i))]
rest' f :: a -> b
f) = Int -> (a -> b) -> ResultList g i a -> ResultList g i b
forall t r (g :: (* -> *) -> *) s.
Int -> (t -> r) -> ResultList g s t -> ResultList g s r
continue' Int
l a -> b
f ([(i, g (ResultList g i))] -> ResultList g i a
q [(i, g (ResultList g i))]
rest')
continue' :: Int -> (t -> r) -> ResultList g s t -> ResultList g s r
continue' l :: Int
l f :: t -> r
f (ResultList rs :: BinTree (ResultInfo g s t)
rs failure :: FailureInfo
failure) = BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
forall t r (g :: (* -> *) -> *) s.
Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust Int
l t -> r
f (ResultInfo g s t -> ResultInfo g s r)
-> BinTree (ResultInfo g s t) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s t)
rs) FailureInfo
failure
adjust :: Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust l :: Int
l f :: t -> r
f (ResultInfo l' :: Int
l' rest' :: [(s, g (ResultList g s))]
rest' a :: t
a) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' (t -> r
f t
a)
{-# INLINABLE pure #-}
{-# INLINABLE (<*>) #-}
instance Alternative (Parser g i) where
empty :: Parser g i a
empty = ([(i, g (ResultList g i))] -> ResultList g i a) -> Parser g i a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\rest :: [(i, g (ResultList g i))]
rest-> BinTree (ResultInfo g i a) -> FailureInfo -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g i a)
forall a. Monoid a => a
mempty (FailureInfo -> ResultList g i a)
-> FailureInfo -> ResultList g i a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo ([(i, g (ResultList g i))] -> Int
forall i a. Num i => [a] -> i
genericLength [(i, g (ResultList g i))]
rest) ["empty"])
Parser p :: [(i, g (ResultList g i))] -> ResultList g i a
p <|> :: Parser g i a -> Parser g i a -> Parser g i a
<|> Parser q :: [(i, g (ResultList g i))] -> ResultList g i a
q = ([(i, g (ResultList g i))] -> ResultList g i a) -> Parser g i a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(i, g (ResultList g i))] -> ResultList g i a
r where
r :: [(i, g (ResultList g i))] -> ResultList g i a
r rest :: [(i, g (ResultList g i))]
rest = [(i, g (ResultList g i))] -> ResultList g i a
p [(i, g (ResultList g i))]
rest ResultList g i a -> ResultList g i a -> ResultList g i a
forall a. Semigroup a => a -> a -> a
<> [(i, g (ResultList g i))] -> ResultList g i a
q [(i, g (ResultList g i))]
rest
{-# INLINABLE (<|>) #-}
infixl 3 <<|>
(<<|>) :: Parser g s a -> Parser g s a -> Parser g s a
Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p <<|> :: Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser q :: [(s, g (ResultList g s))] -> ResultList g s a
q = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
r where
r :: [(s, g (ResultList g s))] -> ResultList g s a
r rest :: [(s, g (ResultList g s))]
rest = case [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest
of rl :: ResultList g s a
rl@(ResultList EmptyTree _failure :: FailureInfo
_failure) -> ResultList g s a
rl ResultList g s a -> ResultList g s a -> ResultList g s a
forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
rl :: ResultList g s a
rl -> ResultList g s a
rl
instance Monad (Parser g i) where
return :: a -> Parser g i a
return = a -> Parser g i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Parser p :: [(i, g (ResultList g i))] -> ResultList g i a
p >>= :: Parser g i a -> (a -> Parser g i b) -> Parser g i b
>>= f :: a -> Parser g i b
f = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(i, g (ResultList g i))] -> ResultList g i b
q where
q :: [(i, g (ResultList g i))] -> ResultList g i b
q rest :: [(i, g (ResultList g i))]
rest = case [(i, g (ResultList g i))] -> ResultList g i a
p [(i, g (ResultList g i))]
rest
of ResultList results :: BinTree (ResultInfo g i a)
results failure :: FailureInfo
failure -> BinTree (ResultInfo g i b) -> FailureInfo -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g i b)
forall a. Monoid a => a
mempty FailureInfo
failure ResultList g i b -> ResultList g i b -> ResultList g i b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo g i a -> ResultList g i b)
-> BinTree (ResultInfo g i a) -> ResultList g i b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo g i a -> ResultList g i b
continue BinTree (ResultInfo g i a)
results
continue :: ResultInfo g i a -> ResultList g i b
continue (ResultInfo l :: Int
l rest' :: [(i, g (ResultList g i))]
rest' a :: a
a) = Int -> ResultList g i b -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
Int -> ResultList g s r -> ResultList g s r
continue' Int
l (Parser g i b -> [(i, g (ResultList g i))] -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser (a -> Parser g i b
f a
a) [(i, g (ResultList g i))]
rest')
continue' :: Int -> ResultList g s r -> ResultList g s r
continue' l :: Int
l (ResultList rs :: BinTree (ResultInfo g s r)
rs failure :: FailureInfo
failure) = BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (Int -> ResultInfo g s r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> ResultInfo g s r -> ResultInfo g s r
adjust Int
l (ResultInfo g s r -> ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rs) FailureInfo
failure
adjust :: Int -> ResultInfo g s r -> ResultInfo g s r
adjust l :: Int
l (ResultInfo l' :: Int
l' rest' :: [(s, g (ResultList g s))]
rest' a :: r
a) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' r
a
instance MonadPlus (Parser g s) where
mzero :: Parser g s a
mzero = Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Parser g s a -> Parser g s a -> Parser g s a
mplus = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance Semigroup x => Semigroup (Parser g s x) where
<> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid x => Monoid (Parser g s x) where
mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Monoid a => a -> a -> a
mappend
instance GrammarParsing Parser where
type GrammarFunctor Parser = ResultList
nonTerminal :: (g (GrammarFunctor Parser g s) -> GrammarFunctor Parser g s a)
-> Parser g s a
nonTerminal f :: g (GrammarFunctor Parser g s) -> GrammarFunctor Parser g s a
f = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p where
p :: [(s, g (ResultList g s))] -> ResultList g s a
p ((_, d :: g (ResultList g s)
d) : _) = g (GrammarFunctor Parser g s) -> GrammarFunctor Parser g s a
f g (GrammarFunctor Parser g s)
g (ResultList g s)
d
p _ = BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["NonTerminal at endOfInput"])
{-# INLINE nonTerminal #-}
instance MultiParsing Parser where
type ResultFunctor Parser = Compose ParseResults []
parsePrefix :: g (Parser g s) -> s -> g (Compose (ResultFunctor Parser) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a.
ResultList g s a -> Compose (Compose ParseResults []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (Compose ParseResults []) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose ParseResults [] (s, a)
-> Compose (Compose ParseResults []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose ParseResults [] (s, a)
-> Compose (Compose ParseResults []) ((,) s) a)
-> (ResultList g s a -> Compose ParseResults [] (s, a))
-> ResultList g s a
-> Compose (Compose ParseResults []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a))
-> (ResultList g s a -> Either ParseFailure [(s, a)])
-> ResultList g s a
-> Compose ParseResults [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either ParseFailure [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> ResultList g s r -> ParseResults [(s, r)]
fromResultList s
input) ((s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a, b) -> b
snd ((s, g (ResultList g s)) -> g (ResultList g s))
-> (s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails g (Parser g s)
g s
input)
parseComplete :: forall g s. (Rank2.Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> g (Compose ParseResults [])
parseComplete :: g (Parser g s) -> s -> g (Compose ParseResults [])
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a. ResultList g s a -> Compose ParseResults [] a)
-> g (ResultList g s) -> g (Compose ParseResults [])
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose ParseResults [] (s, a) -> Compose ParseResults [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose ParseResults [] (s, a) -> Compose ParseResults [] a)
-> (ResultList g s a -> Compose ParseResults [] (s, a))
-> ResultList g s a
-> Compose ParseResults [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a))
-> (ResultList g s a -> Either ParseFailure [(s, a)])
-> ResultList g s a
-> Compose ParseResults [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either ParseFailure [(s, a)]
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> ResultList g s r -> ParseResults [(s, r)]
fromResultList s
input)
((s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a, b) -> b
snd ((s, g (ResultList g s)) -> g (ResultList g s))
-> (s, g (ResultList g s)) -> g (ResultList g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails g (Parser g s)
close ([(s, g (ResultList g s))] -> [(s, g (ResultList g s))])
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (ResultList g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails g (Parser g s)
g s
input)
where close :: g (Parser g s)
close = (forall a. Parser g s a -> Parser g s a)
-> g (Parser g s) -> g (Parser g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Parser g s a -> Parser g s () -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser g s ()
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput) g (Parser g s)
g
parseTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails :: g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseTails g :: g (Parser g s)
g input :: s
input = (s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))])
-> [(s, g (ResultList g s))] -> [s] -> [(s, g (ResultList g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
where parseTail :: s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail s :: s
s parsedTail :: [(s, g (ResultList g s))]
parsedTail = [(s, g (ResultList g s))]
parsed
where parsed :: [(s, g (ResultList g s))]
parsed = (s
s,g (ResultList g s)
d)(s, g (ResultList g s))
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsedTail
d :: g (ResultList g s)
d = (forall a. Parser g s a -> ResultList g s a)
-> g (Parser g s) -> g (ResultList g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((([(s, g (ResultList g s))] -> ResultList g s a)
-> [(s, g (ResultList g s))] -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))]
parsed) (([(s, g (ResultList g s))] -> ResultList g s a)
-> ResultList g s a)
-> (Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a)
-> Parser g s a
-> ResultList g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser) g (Parser g s)
g
reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails :: g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails _ [] = []
reparseTails final :: g (Parser g s)
final parsed :: [(s, g (ResultList g s))]
parsed@((s :: s
s, _):_) = (s
s, g (ResultList g s)
gd)(s, g (ResultList g s))
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsed
where gd :: g (ResultList g s)
gd = (forall a. Parser g s a -> ResultList g s a)
-> g (Parser g s) -> g (ResultList g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
`applyParser` [(s, g (ResultList g s))]
parsed) g (Parser g s)
final
instance MonoidParsing (Parser g) where
endOfInput :: Parser g s ()
endOfInput = Parser g s ()
forall (m :: * -> *). Parsing m => m ()
eof
getInput :: Parser g s s
getInput = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
Monoid r =>
[(r, g (ResultList g r))] -> ResultList g r r
p
where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((s :: r
s, _):_) = BinTree (ResultInfo g r r) -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(r, g (ResultList g r))]
rest r
s) FailureInfo
forall a. Monoid a => a
mempty
p [] = BinTree (ResultInfo g r r) -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] r
forall a. Monoid a => a
mempty) FailureInfo
forall a. Monoid a => a
mempty
anyToken :: Parser g s s
anyToken = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
FactorialMonoid r =>
[(r, g (ResultList g r))] -> ResultList g r r
p
where p :: [(r, g (ResultList g r))] -> ResultList g r r
p rest :: [(r, g (ResultList g r))]
rest@((s :: r
s, _):t :: [(r, g (ResultList g r))]
t) = case r -> Maybe (r, r)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix r
s
of Just (first :: r
first, _) -> BinTree (ResultInfo g r r) -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(r, g (ResultList g r))]
t r
first) FailureInfo
forall a. Monoid a => a
mempty
_ -> BinTree (ResultInfo g r r) -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(r, g (ResultList g r))] -> Int
forall i a. Num i => [a] -> i
genericLength [(r, g (ResultList g r))]
rest) ["anyToken"])
p [] = BinTree (ResultInfo g r r) -> FailureInfo -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["anyToken"])
satisfy :: (s -> Bool) -> Parser g s s
satisfy predicate :: s -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):t :: [(s, g (ResultList g s))]
t) =
case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s
of Just (first :: s
first, _) | s -> Bool
predicate s
first -> BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(s, g (ResultList g s))]
t s
first) FailureInfo
forall a. Monoid a => a
mempty
_ -> BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfy"])
p [] = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfy"])
satisfyChar :: (Char -> Bool) -> Parser g s Char
satisfyChar predicate :: Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s Char)
-> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s Char
p
where p :: [(s, g (ResultList g s))] -> ResultList g s Char
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):t :: [(s, g (ResultList g s))]
t) =
case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just first :: Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s Char) -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a. a -> BinTree a
Leaf (ResultInfo g s Char -> BinTree (ResultInfo g s Char))
-> ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> Char -> ResultInfo g s Char
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(s, g (ResultList g s))]
t Char
first) FailureInfo
forall a. Monoid a => a
mempty
_ -> BinTree (ResultInfo g s Char) -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfyChar"])
p [] = BinTree (ResultInfo g s Char) -> FailureInfo -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyChar"])
satisfyCharInput :: (Char -> Bool) -> Parser g s s
satisfyCharInput predicate :: Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):t :: [(s, g (ResultList g s))]
t) =
case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just first :: Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(s, g (ResultList g s))]
t (s -> ResultInfo g s s) -> s -> ResultInfo g s s
forall a b. (a -> b) -> a -> b
$ s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) FailureInfo
forall a. Monoid a => a
mempty
_ -> BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["satisfyCharInput"])
p [] = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyCharInput"])
scan :: s -> (s -> t -> Maybe s) -> Parser g t t
scan s0 :: s
s0 f :: s -> t -> Maybe s
f = ([(t, g (ResultList g t))] -> ResultList g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (s -> [(t, g (ResultList g t))] -> ResultList g t t
p s
s0)
where p :: s -> [(t, g (ResultList g t))] -> ResultList g t t
p s :: s
s rest :: [(t, g (ResultList g t))]
rest@((i :: t
i, _) : _) = BinTree (ResultInfo g t t) -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a. a -> BinTree a
Leaf (ResultInfo g t t -> BinTree (ResultInfo g t t))
-> ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a b. (a -> b) -> a -> b
$ Int -> [(t, g (ResultList g t))] -> t -> ResultInfo g t t
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(t, g (ResultList g t))] -> [(t, g (ResultList g t))]
forall a. Int -> [a] -> [a]
drop Int
l [(t, g (ResultList g t))]
rest) t
prefix) FailureInfo
forall a. Monoid a => a
mempty
where (prefix :: t
prefix, _, _) = s -> (s -> t -> Maybe s) -> t -> (t, t, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s s -> t -> Maybe s
f t
i
l :: Int
l = t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix
p _ [] = BinTree (ResultInfo g t t) -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a. a -> BinTree a
Leaf (ResultInfo g t t -> BinTree (ResultInfo g t t))
-> ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a b. (a -> b) -> a -> b
$ Int -> [(t, g (ResultList g t))] -> t -> ResultInfo g t t
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] t
forall a. Monoid a => a
mempty) FailureInfo
forall a. Monoid a => a
mempty
scanChars :: s -> (s -> Char -> Maybe s) -> Parser g t t
scanChars s0 :: s
s0 f :: s -> Char -> Maybe s
f = ([(t, g (ResultList g t))] -> ResultList g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (s -> [(t, g (ResultList g t))] -> ResultList g t t
p s
s0)
where p :: s -> [(t, g (ResultList g t))] -> ResultList g t t
p s :: s
s rest :: [(t, g (ResultList g t))]
rest@((i :: t
i, _) : _) = BinTree (ResultInfo g t t) -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a. a -> BinTree a
Leaf (ResultInfo g t t -> BinTree (ResultInfo g t t))
-> ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a b. (a -> b) -> a -> b
$ Int -> [(t, g (ResultList g t))] -> t -> ResultInfo g t t
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(t, g (ResultList g t))] -> [(t, g (ResultList g t))]
forall a. Int -> [a] -> [a]
drop Int
l [(t, g (ResultList g t))]
rest) t
prefix) FailureInfo
forall a. Monoid a => a
mempty
where (prefix :: t
prefix, _, _) = s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s s -> Char -> Maybe s
f t
i
l :: Int
l = t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix
p _ [] = BinTree (ResultInfo g t t) -> FailureInfo -> ResultList g t t
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a. a -> BinTree a
Leaf (ResultInfo g t t -> BinTree (ResultInfo g t t))
-> ResultInfo g t t -> BinTree (ResultInfo g t t)
forall a b. (a -> b) -> a -> b
$ Int -> [(t, g (ResultList g t))] -> t -> ResultInfo g t t
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] t
forall a. Monoid a => a
mempty) FailureInfo
forall a. Monoid a => a
mempty
takeWhile :: (s -> Bool) -> Parser g s s
takeWhile predicate :: s -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo
forall a. Monoid a => a
mempty
p [] = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo
forall a. Monoid a => a
mempty
takeWhile1 :: (s -> Bool) -> Parser g s s
takeWhile1 predicate :: s -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo
forall a. Monoid a => a
mempty
p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["takeWhile1"])
takeCharsWhile :: (Char -> Bool) -> Parser g s s
takeCharsWhile predicate :: Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo
forall a. Monoid a => a
mempty
p [] = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo
forall a. Monoid a => a
mempty
takeCharsWhile1 :: (Char -> Bool) -> Parser g s s
takeCharsWhile1 predicate :: Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo
forall a. Monoid a => a
mempty
p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["takeCharsWhile1"])
string :: s -> Parser g s s
string s :: s
s = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p where
p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s' :: s
s', _) : _)
| s
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) s
s) FailureInfo
forall a. Monoid a => a
mempty
p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s])
l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s
notSatisfy :: (s -> Bool) -> Parser g s ()
notSatisfy predicate :: s -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_)
| Just (first :: s
first, _) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s,
s -> Bool
predicate s
first = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["notSatisfy"])
p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo
forall a. Monoid a => a
mempty
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar predicate :: Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_)
| Just first :: Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s,
Char -> Bool
predicate Char
first = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["notSatisfyChar"])
p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo
forall a. Monoid a => a
mempty
{-# INLINABLE string #-}
instance MonoidNull s => Parsing (Parser g s) where
try :: Parser g s a -> Parser g s a
try (Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q rest :: [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
rewindFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
where rewindFailure :: ResultList g s a -> ResultList g s a
rewindFailure (ResultList rl :: BinTree (ResultInfo g s a)
rl (FailureInfo _pos :: Int
_pos _msgs :: [String]
_msgs)) =
BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
rl (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [])
Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> msg :: String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
where q :: [(s, g (ResultList g s))] -> ResultList g s a
q rest :: [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
replaceFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
where replaceFailure :: ResultList g s a -> ResultList g s a
replaceFailure (ResultList EmptyTree (FailureInfo pos :: Int
pos msgs :: [String]
msgs)) =
BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. BinTree a
EmptyTree (Int -> [String] -> FailureInfo
FailureInfo Int
pos ([String] -> FailureInfo) -> [String] -> FailureInfo
forall a b. (a -> b) -> a -> b
$ if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest then [String
msg] else [String]
msgs)
replaceFailure rl :: ResultList g s a
rl = ResultList g s a
rl
notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\input :: [(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s ()
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s r.
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind t :: [(s, g (ResultList g s))]
t (ResultList EmptyTree _) = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
t ()) FailureInfo
forall a. Monoid a => a
mempty
rewind t :: [(s, g (ResultList g s))]
t ResultList{} = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) ["notFollowedBy"])
skipMany :: Parser g s a -> Parser g s ()
skipMany p :: Parser g s a
p = Parser g s ()
go
where go :: Parser g s ()
go = () -> Parser g s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Parser g s () -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser g s a
p Parser g s a -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
unexpected :: String -> Parser g s a
unexpected msg :: String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\t :: [(s, g (ResultList g s))]
t-> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (FailureInfo -> ResultList g s a)
-> FailureInfo -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) [String
msg])
eof :: Parser g s ()
eof = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
forall s (g :: (* -> *) -> *).
MonoidNull s =>
[(s, g (ResultList g s))] -> ResultList g s ()
f
where f :: [(s, g (ResultList g s))] -> ResultList g s ()
f rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_)
| s -> Bool
forall m. MonoidNull m => m -> Bool
null s
s = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo
forall a. Monoid a => a
mempty
| Bool
otherwise = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) ["endOfInput"])
f [] = BinTree (ResultInfo g s ()) -> FailureInfo -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] ()) FailureInfo
forall a. Monoid a => a
mempty
instance MonoidNull s => LookAheadParsing (Parser g s) where
lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser p :: [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\input :: [(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s a
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s 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 t :: [(s, g (ResultList g s))]
t (ResultList rl :: BinTree (ResultInfo g s r)
rl failure :: FailureInfo
failure) = BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList ([(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s r.
[(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
rewindInput [(s, g (ResultList g s))]
t (ResultInfo g s r -> ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rl) FailureInfo
failure
rewindInput :: [(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
rewindInput t :: [(s, g (ResultList g s))]
t (ResultInfo _ _ r :: r
r) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
t r
r
instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where
satisfy :: (Char -> Bool) -> Parser g s Char
satisfy = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar
string :: String -> Parser g s String
string s :: String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
Show s) =>
s -> m s s
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
char :: Char -> Parser g s Char
char = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
notChar :: Char -> Parser g s Char
notChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
anyChar :: Parser g s Char
anyChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
text :: Text -> Parser g s Text
text t :: Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
Show s) =>
s -> m s s
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)
instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
someSpace :: Parser g s ()
someSpace = Parser g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
someLexicalSpace
semi :: Parser g s Char
semi = Parser g s Char
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s Char
lexicalSemicolon
token :: Parser g s a -> Parser g s a
token = Parser g s a -> Parser g s a
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken
fromResultList :: FactorialMonoid s => s -> ResultList g s r -> ParseResults [(s, r)]
fromResultList :: s -> ResultList g s r -> ParseResults [(s, r)]
fromResultList s :: s
s (ResultList EmptyTree (FailureInfo pos :: Int
pos msgs :: [String]
msgs)) =
ParseFailure -> ParseResults [(s, r)]
forall a b. a -> Either a b
Left (Int -> [String] -> ParseFailure
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
msgs))
fromResultList _ (ResultList rl :: BinTree (ResultInfo g s r)
rl _failure :: FailureInfo
_failure) = [(s, r)] -> ParseResults [(s, r)]
forall a b. b -> Either a b
Right (ResultInfo g s r -> (s, r)
forall a (g :: (* -> *) -> *) b.
Monoid a =>
ResultInfo g a b -> (a, b)
f (ResultInfo g s r -> (s, r)) -> [ResultInfo g s r] -> [(s, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r) -> [ResultInfo g s r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo g s r)
rl)
where f :: ResultInfo g a b -> (a, b)
f (ResultInfo _ ((s :: a
s, _):_) r :: b
r) = (a
s, b
r)
f (ResultInfo _ [] r :: b
r) = (a
forall a. Monoid a => a
mempty, b
r)
longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: Parser g s a -> Parser g [(s, g (ResultList g s))] a
longest p :: Parser g s a
p = ([(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a)
-> Parser g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q where
q :: [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q rest :: [(s, g (ResultList g s))]
rest = case Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser Parser g s a
p [(s, g (ResultList g s))]
rest
of ResultList EmptyTree failure :: FailureInfo
failure -> FailureInfo -> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
Backtrack.NoParse FailureInfo
failure
ResultList rs :: BinTree (ResultInfo g s a)
rs _ -> ResultInfo g s a -> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed ((ResultInfo g s a -> ResultInfo g s a -> Ordering)
-> BinTree (ResultInfo g s a) -> ResultInfo g s a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (ResultInfo g s a -> Int)
-> ResultInfo g s a
-> ResultInfo g s a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ResultInfo g s a -> Int
forall (g :: (* -> *) -> *) s r. ResultInfo g s r -> Int
resultLength) BinTree (ResultInfo g s a)
rs)
resultLength :: ResultInfo g s r -> Int
resultLength (ResultInfo l :: Int
l _ _) = Int
l
parsed :: ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed (ResultInfo l :: Int
l s :: [(s, g (ResultList g s))]
s r :: v
r) = Int
-> v
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultList g s))]
s
peg :: Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg :: Parser g [(s, g (ResultList g s))] a -> Parser g s a
peg p :: Parser g [(s, g (ResultList g s))] a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
q :: [(s, g (ResultList g s))] -> ResultList g s a
q rest :: [(s, g (ResultList g s))]
rest = case Parser g [(s, g (ResultList g s))] a
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultList g s))] a
p [(s, g (ResultList g s))]
rest
of Backtrack.Parsed l :: Int
l result :: a
result suffix :: [(s, g (ResultList g s))]
suffix -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
suffix a
result) FailureInfo
forall a. Monoid a => a
mempty
Backtrack.NoParse failure :: FailureInfo
failure -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty FailureInfo
failure
terminalPEG :: Monoid s => Backtrack.Parser g s a -> Parser g s a
terminalPEG :: Parser g s a -> Parser g s a
terminalPEG p :: Parser g s a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
q :: [(s, g (ResultList g s))] -> ResultList g s a
q [] = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
forall a. Monoid a => a
mempty
of Backtrack.Parsed l :: Int
l result :: a
result _ -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [] a
result) FailureInfo
forall a. Monoid a => a
mempty
Backtrack.NoParse failure :: FailureInfo
failure -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty FailureInfo
failure
q rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_) = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
of Backtrack.Parsed l :: Int
l result :: a
result _ -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) a
result) FailureInfo
forall a. Monoid a => a
mempty
Backtrack.NoParse failure :: FailureInfo
failure -> BinTree (ResultInfo g s a) -> FailureInfo -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty FailureInfo
failure