{-# 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.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.Semigroup (Semigroup((<>)))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
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 qualified Rank2

import Text.Grampa.Class (GrammarParsing(..), MultiParsing(..),
                          DeterministicParsing(..), InputParsing(..), InputCharParsing(..),
                          TailsParsing(parseTails), ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (BinTree(..), FailureInfo(..))
import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack

import Prelude hiding (iterate, length, null, showList, span, takeWhile)

-- | Parser for a context-free grammar with packrat-like sharing of parse results. It does not support left-recursive
-- grammars.
newtype Parser g s r = Parser{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 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 l :: BinTree (ResultInfo g s r)
l f :: FailureInfo s
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 s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f ")")

instance Show s => 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 s
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 s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f String
rest)
      where simplify :: ResultInfo g s r -> r
simplify (ResultInfo _ _ r :: r
r) = r
r

instance (Show s, 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 s
failure) = BinTree (ResultInfo g s b) -> FailureInfo s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList ((a -> b
f (a -> b) -> ResultInfo g s a -> ResultInfo g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo g s a -> ResultInfo g s b)
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a)
l) FailureInfo s
failure

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

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

instance 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 i -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> 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 i
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 i
failure -> BinTree (ResultInfo g i b) -> FailureInfo i -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g i b)
forall a. Monoid a => a
mempty FailureInfo i
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 s
failure) = BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
forall t r (g :: (* -> *) -> *) s.
Int -> (t -> r) -> ResultInfo g s t -> ResultInfo g s r
adjust Int
l t -> r
f (ResultInfo g s t -> ResultInfo g s r)
-> BinTree (ResultInfo g s t) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s t)
rs) FailureInfo s
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 i -> ResultList g i a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g i a)
forall a. Monoid a => a
mempty (FailureInfo i -> ResultList g i a)
-> FailureInfo i -> ResultList g i a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected i] -> FailureInfo i
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(i, g (ResultList g i))] -> Int
forall i a. Num i => [a] -> i
genericLength [(i, g (ResultList g i))]
rest) [String -> Expected i
forall s. String -> Expected s
Expected "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 (<|>) #-}

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 i
failure -> BinTree (ResultInfo g i b) -> FailureInfo i -> ResultList g i b
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g i b)
forall a. Monoid a => a
mempty FailureInfo i
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 s
failure) = BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (Int -> ResultInfo g s r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> ResultInfo g s r -> ResultInfo g s r
adjust Int
l (ResultInfo g s r -> ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rs) FailureInfo s
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 (Eq 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 :: ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult s :: ParserInput (Parser g s)
s = Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (Either (ParseFailure s)) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList s
ParserInput (Parser g s)
s
   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 (ResultList g s)
g (GrammarFunctor (Parser g s))
d
      p _ = BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "NonTerminal at endOfInput"])
   {-# INLINE nonTerminal #-}

instance (Eq s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
   parseTails :: Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser

-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left
-- recursion support.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (LeftReductive s, FactorialMonoid s) => MultiParsing (Parser g s) where
   type GrammarConstraint (Parser g s) g' = (g ~ g', Rank2.Functor g)
   type ResultFunctor (Parser g s) = Compose (ParseResults s) []
   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
   parsePrefix :: g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a.
 ResultList g s a
 -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (Compose (ParseResults s) []) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (Either (ParseFailure s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure s)) [] (s, a)
 -> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a)
-> (ResultList g s a
    -> Compose (Either (ParseFailure s)) [] (s, a))
-> ResultList g s a
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (Either (ParseFailure s)) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(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))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
   parseComplete :: (Rank2.Functor g, Eq s, FactorialMonoid s) =>
                    g (Parser g s) -> s -> g (Compose (ParseResults s) [])
   parseComplete :: g (Parser g s) -> s -> g (Compose (ParseResults s) [])
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a. ResultList g s a -> Compose (ParseResults s) [] a)
-> g (ResultList g s) -> g (Compose (ParseResults s) [])
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
 -> Compose (ParseResults s) [] a)
-> (ResultList g s a -> Compose (ParseResults s) [] (s, a))
-> ResultList g s a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (ParseResults s) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (ParseResults s) [] (s, a))
-> (ResultList g s a -> Either (ParseFailure s) [(s, a)])
-> ResultList g s a
-> Compose (ParseResults s) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList g s a -> Either (ParseFailure s) [(s, a)]
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> ResultList g s r -> ParseResults s [(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))]
parseGrammarTails 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 :: * -> *). 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 :: g (Parser g s) -> s -> [(s, g (ResultList g s))]
parseGrammarTails 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 (LeftReductive s, FactorialMonoid s) => InputParsing (Parser g s) where
   type ParserInput (Parser g s) = s
   getInput :: Parser g s (ParserInput (Parser g s))
getInput = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
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 r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(r, g (ResultList g r))]
rest r
s) FailureInfo r
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g r r) -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] r
forall a. Monoid a => a
mempty) FailureInfo r
forall a. Monoid a => a
mempty
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
forall r (g :: (* -> *) -> *).
FactorialMonoid r =>
[(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 r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a. a -> BinTree a
Leaf (ResultInfo g r r -> BinTree (ResultInfo g r r))
-> ResultInfo g r r -> BinTree (ResultInfo g r r)
forall a b. (a -> b) -> a -> b
$ Int -> [(r, g (ResultList g r))] -> r -> ResultInfo g r r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(r, g (ResultList g r))]
t r
first) FailureInfo r
forall a. Monoid a => a
mempty
                                   _ -> BinTree (ResultInfo g r r) -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Int -> [Expected r] -> FailureInfo r
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(r, g (ResultList g r))] -> Int
forall i a. Num i => [a] -> i
genericLength [(r, g (ResultList g r))]
rest) [String -> Expected r
forall s. String -> Expected s
Expected "anyToken"])
            p [] = BinTree (ResultInfo g r r) -> FailureInfo r -> ResultList g r r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g r r)
forall a. Monoid a => a
mempty (Int -> [Expected r] -> FailureInfo r
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected r
forall s. String -> Expected s
Expected "anyToken"])
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy predicate :: ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
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, _) | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(s, g (ResultList g s))]
t s
first) FailureInfo s
forall a. Monoid a => a
mempty
                  _ -> BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
            p [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
   scan :: state
-> (state -> ParserInput (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan s0 :: state
s0 f :: state -> ParserInput (Parser g s) -> Maybe state
f = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p s :: state
s rest :: [(s, g (ResultList g s))]
rest@((i :: s
i, _) : _) = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
prefix) FailureInfo s
forall a. Monoid a => a
mempty
               where (prefix :: s
prefix, _, _) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (Parser g s) -> Maybe state
f s
i
                     l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p _ [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo s
forall a. Monoid a => a
mempty
   take :: Int -> Parser g s (ParserInput (Parser g s))
take 0 = Parser g s (ParserInput (Parser g s))
forall a. Monoid a => a
mempty
   take n :: Int
n = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
               | s
x <- Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n =
                    BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo s
forall a. Monoid a => a
mempty
            p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected (String -> Expected s) -> String -> Expected s
forall a b. (a -> b) -> a -> b
$ "take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile predicate :: ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo s
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo s
forall a. Monoid a => a
mempty
   takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 predicate :: ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _) : _)
               | s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
                    BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo s
forall a. Monoid a => a
mempty
            p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "takeWhile1"])
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string s :: ParserInput (Parser g s)
s = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p where
      p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s' :: s
s', _) : _)
         | s
ParserInput (Parser g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop Int
l [(s, g (ResultList g s))]
rest) s
ParserInput (Parser g s)
s) FailureInfo s
forall a. Monoid a => a
mempty
      p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [s -> Expected s
forall s. s -> Expected s
ExpectedInput s
ParserInput (Parser g s)
s])
      l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy predicate :: ParserInput (Parser g s) -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s :: s
s, _):_)
               | Just (first :: s
first, _) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfy"])
            p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo s
forall a. Monoid a => a
mempty
   {-# INLINABLE string #-}

instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g 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 s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 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 s
forall a. Monoid a => a
mempty
                  _ -> BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
            p [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
   scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars s0 :: state
s0 f :: state -> Char -> Maybe state
f = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p s :: state
s rest :: [(s, g (ResultList g s))]
rest@((i :: s
i, _) : _) = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
prefix) FailureInfo s
forall a. Monoid a => a
mempty
               where (prefix :: s
prefix, _, _) = state -> (state -> Char -> Maybe state) -> s -> (s, 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 = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix
            p _ [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo s
forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g 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 s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo s
forall a. Monoid a => a
mempty
            p [] = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] s
forall a. Monoid a => a
mempty) FailureInfo s
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g 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 s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a. a -> BinTree a
Leaf (ResultInfo g s s -> BinTree (ResultInfo g s s))
-> ResultInfo g s s -> BinTree (ResultInfo g s s)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> s -> ResultInfo g s s
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) s
x) FailureInfo s
forall a. Monoid a => a
mempty
            p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s s) -> FailureInfo s -> ResultList g s s
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "takeCharsWhile1"])
   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 s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfyChar"])
            p rest :: [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo s
forall a. Monoid a => a
mempty

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 :: [Expected s]
_msgs)) =
                        BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
rl (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
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 :: [Expected s]
msgs)) =
                        BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. BinTree a
EmptyTree (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected s] -> FailureInfo s) -> [Expected s] -> FailureInfo s
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 -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
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 s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
t ()) FailureInfo s
forall a. Monoid a => a
mempty
            rewind t :: [(s, g (ResultList g s))]
t ResultList{} = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected "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 s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList g s a)
-> FailureInfo s -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected 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 s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [(s, g (ResultList g s))]
rest ()) FailureInfo s
forall a. Monoid a => a
mempty
               | Bool
otherwise = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "endOfInput"])
            f [] = BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 0 [] ()) FailureInfo s
forall a. Monoid a => a
mempty

instance MonoidNull s => DeterministicParsing (Parser g s) where
   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 s
_failure) -> ResultList g s a
rl ResultList g s a -> ResultList g s a -> ResultList g s a
forall a. Semigroup a => a -> a -> a
<> [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest
                  rl :: ResultList g s a
rl -> ResultList g s a
rl
   takeSome :: Parser g s a -> Parser g s [a]
takeSome p :: Parser g s a
p = (:) (a -> [a] -> [a]) -> Parser g s a -> Parser g s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p Parser g s ([a] -> [a]) -> Parser g s [a] -> Parser g s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser g s a -> Parser g s [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany Parser g s a
p
   takeMany :: Parser g s a -> Parser g s [a]
takeMany (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 (Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q 0 [a] -> [a]
forall a. a -> a
id) where
      q :: Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q len :: Int
len acc :: [a] -> [a]
acc 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 ResultList EmptyTree _failure :: FailureInfo s
_failure -> BinTree (ResultInfo g s [a]) -> FailureInfo s -> ResultList g s [a]
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s [a] -> BinTree (ResultInfo g s [a])
forall a. a -> BinTree a
Leaf (ResultInfo g s [a] -> BinTree (ResultInfo g s [a]))
-> ResultInfo g s [a] -> BinTree (ResultInfo g s [a])
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> [a] -> ResultInfo g s [a]
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
len [(s, g (ResultList g s))]
rest ([a] -> [a]
acc [])) FailureInfo s
forall a. Monoid a => a
mempty
                          ResultList rl :: BinTree (ResultInfo g s a)
rl _ -> (ResultInfo g s a -> ResultList g s [a])
-> BinTree (ResultInfo g s a) -> ResultList g s [a]
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 len' :: Int
len' rest' :: [(s, g (ResultList g s))]
rest' result :: a
result) = Int
-> ([a] -> [a]) -> [(s, g (ResultList g s))] -> ResultList g s [a]
q (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') ([a] -> [a]
acc ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
resulta -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [(s, g (ResultList g s))]
rest'
   skipAll :: Parser g s a -> Parser g s ()
skipAll (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 (Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q 0) where
      q :: Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q len :: Int
len 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 ResultList EmptyTree _failure :: FailureInfo s
_failure -> BinTree (ResultInfo g s ()) -> FailureInfo s -> ResultList g s ()
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a. a -> BinTree a
Leaf (ResultInfo g s () -> BinTree (ResultInfo g s ()))
-> ResultInfo g s () -> BinTree (ResultInfo g s ())
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> () -> ResultInfo g s ()
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
len [(s, g (ResultList g s))]
rest ()) FailureInfo s
forall a. Monoid a => a
mempty
                      ResultList rl :: BinTree (ResultInfo g s a)
rl _failure :: FailureInfo s
_failure -> (ResultInfo g s a -> ResultList g s ())
-> BinTree (ResultInfo g s a) -> ResultList g s ()
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 len' :: Int
len' rest' :: [(s, g (ResultList g s))]
rest' _) = Int -> [(s, g (ResultList g s))] -> ResultList g s ()
q (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') [(s, g (ResultList g s))]
rest'

instance MonoidNull s => 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 :: (* -> *) -> *) 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 s
failure) = BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList ([(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s r.
[(s, g (ResultList g s))] -> ResultInfo g s r -> ResultInfo g s r
rewindInput [(s, g (ResultList g s))]
t (ResultInfo g s r -> ResultInfo g s r)
-> BinTree (ResultInfo g s r) -> BinTree (ResultInfo g s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r)
rl) FailureInfo s
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 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 s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a. a -> BinTree a
Leaf (ResultInfo g s Char -> BinTree (ResultInfo g s Char))
-> ResultInfo g s Char -> BinTree (ResultInfo g s Char)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> Char -> ResultInfo g s Char
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo 1 [(s, g (ResultList g s))]
t Char
first) FailureInfo s
forall a. Monoid a => a
mempty
                  _ -> BinTree (ResultInfo g s Char)
-> FailureInfo s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (ResultList g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (ResultList g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
            p [] = BinTree (ResultInfo g s Char)
-> FailureInfo s -> ResultList g s Char
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s Char)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo 0 [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
   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
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text 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
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

fromResultList :: (Eq s, FactorialMonoid s) => s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList :: s -> ResultList g s r -> ParseResults s [(s, r)]
fromResultList s :: s
s (ResultList EmptyTree (FailureInfo pos :: Int
pos msgs :: [Expected s]
msgs)) = ParseFailure s -> ParseResults s [(s, r)]
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
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) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList _ (ResultList rl :: BinTree (ResultInfo g s r)
rl _failure :: FailureInfo s
_failure) = [(s, r)] -> ParseResults s [(s, r)]
forall a b. b -> Either a b
Right (ResultInfo g s r -> (s, r)
forall a (g :: (* -> *) -> *) b.
Monoid a =>
ResultInfo g a b -> (a, b)
f (ResultInfo g s r -> (s, r)) -> [ResultInfo g s r] -> [(s, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s r) -> [ResultInfo g s r]
forall (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)

-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
-- of input tails, opposite of 'peg'
longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: 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 (FailureInfo pos :: Int
pos expected :: [Expected s]
expected) -> FailureInfo [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
Backtrack.NoParse (Int
-> [Expected [(s, g (ResultList g s))]]
-> FailureInfo [(s, g (ResultList g s))]
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected [(s, g (ResultList g s))]]
 -> FailureInfo [(s, g (ResultList g s))])
-> [Expected [(s, g (ResultList g s))]]
-> FailureInfo [(s, g (ResultList g s))]
forall a b. (a -> b) -> a -> b
$ (Expected s -> Expected [(s, g (ResultList g s))])
-> [Expected s] -> [Expected [(s, g (ResultList g s))]]
forall a b. (a -> b) -> [a] -> [b]
map Expected s -> Expected [(s, g (ResultList g s))]
forall a b. Expected a -> Expected [(a, b)]
message [Expected s]
expected)
               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
   message :: Expected a -> Expected [(a, b)]
message (Expected msg :: String
msg) = String -> Expected [(a, b)]
forall s. String -> Expected s
Expected String
msg
   message (ExpectedInput s :: a
s) = [(a, b)] -> Expected [(a, b)]
forall s. s -> Expected s
ExpectedInput [(a
s, String -> b
forall a. HasCallStack => String -> a
error "longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
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 s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [(s, g (ResultList g s))]
suffix a
result) FailureInfo s
forall a. Monoid a => a
mempty
               Backtrack.NoParse (FailureInfo pos :: Int
pos expected :: [Expected [(s, g (ResultList g s))]]
expected) -> BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos (((s, g (ResultList g s)) -> s
forall a b. (a, b) -> a
fst ((s, g (ResultList g s)) -> s)
-> ([(s, g (ResultList g s))] -> (s, g (ResultList g s)))
-> [(s, g (ResultList g s))]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (ResultList g s))] -> (s, g (ResultList g s))
forall a. [a] -> a
head ([(s, g (ResultList g s))] -> s)
-> Expected [(s, g (ResultList g s))] -> Expected s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Expected [(s, g (ResultList g s))] -> Expected s)
-> [Expected [(s, g (ResultList g s))]] -> [Expected s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expected [(s, g (ResultList g s))]]
expected))

-- | Turns a backtracking PEG parser into a context-free parser
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 s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l [] a
result) FailureInfo s
forall a. Monoid a => a
mempty
               Backtrack.NoParse failure :: FailureInfo s
failure -> BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty FailureInfo s
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 s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList (ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a. a -> BinTree a
Leaf (ResultInfo g s a -> BinTree (ResultInfo g s a))
-> ResultInfo g s a -> BinTree (ResultInfo g s a)
forall a b. (a -> b) -> a -> b
$ Int -> [(s, g (ResultList g s))] -> a -> ResultInfo g s a
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
l (Int -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. Int -> [a] -> [a]
drop Int
l [(s, g (ResultList g s))]
rest) a
result) FailureInfo s
forall a. Monoid a => a
mempty
                          Backtrack.NoParse failure :: FailureInfo s
failure -> BinTree (ResultInfo g s a) -> FailureInfo s -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
BinTree (ResultInfo g s r) -> FailureInfo s -> ResultList g s r
ResultList BinTree (ResultInfo g s a)
forall a. Monoid a => a
mempty FailureInfo s
failure