{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.Memoizing
       {-# DEPRECATED "Use Text.Grampa.ContextFree.SortedMemoizing instead" #-}
       (FailureInfo(..), ResultList(..), Parser(..), BinTree(..),
        fromResultList, reparseTails, longest, peg, terminalPEG)
where

import Control.Applicative
import Control.Monad (Monad(..), MonadFail(fail), 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 Debug.Trace (trace)
import Witherable (Filterable(mapMaybe))

import qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.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(..), TraceableParsing(..))
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 BinTree (ResultInfo g s r)
l FailureInfo s
f) = String
"ResultList (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinTree (ResultInfo g s r) -> ShowS
forall a. Show a => a -> ShowS
shows BinTree (ResultInfo g s r)
l (String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f String
")")

instance Show s => Show1 (ResultList g s) where
   liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList g s a -> ShowS
liftShowsPrec Int -> a -> ShowS
_sp [a] -> ShowS
showList Int
_prec (ResultList BinTree (ResultInfo g s a)
l FailureInfo s
f) String
rest = String
"ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (ResultInfo g s a -> a
forall (g :: (* -> *) -> *) s r. ResultInfo g s r -> r
simplify (ResultInfo g s a -> a) -> [ResultInfo g s a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo g s a) -> [ResultInfo g s a]
forall (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 Int
_ [(s, g (ResultList g s))]
_ r
r) = r
r

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

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

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

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

instance Functor (ResultList g s) where
   fmap :: (a -> b) -> ResultList g s a -> ResultList g s b
fmap a -> b
f (ResultList BinTree (ResultInfo g s a)
l 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 Filterable (ResultList g s) where
   mapMaybe :: (a -> Maybe b) -> ResultList g s a -> ResultList g s b
mapMaybe a -> Maybe b
f (ResultList BinTree (ResultInfo g s a)
l 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 ((ResultInfo g s a -> Maybe (ResultInfo g s b))
-> BinTree (ResultInfo g s a) -> BinTree (ResultInfo g s b)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((a -> Maybe b) -> ResultInfo g s a -> Maybe (ResultInfo g s b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f) BinTree (ResultInfo g s a)
l) FailureInfo s
failure

instance Semigroup (ResultList g s r) where
   ResultList BinTree (ResultInfo g s r)
rl1 FailureInfo s
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList BinTree (ResultInfo g s r)
rl2 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 a -> b
f (Parser [(i, g (ResultList g i))] -> ResultList g i a
p) = ([(i, g (ResultList g i))] -> ResultList g i b) -> Parser g i b
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser ((a -> b) -> ResultList g i a -> ResultList g i b
forall (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 = ([(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))]
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 Int
0 [(i, g (ResultList g i))]
rest a
a) FailureInfo i
forall a. Monoid a => a
mempty)
   Parser [(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 [(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 [(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 BinTree (ResultInfo g i (a -> b))
results 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 Int
l [(i, g (ResultList g i))]
rest' 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' Int
l t -> r
f (ResultList BinTree (ResultInfo g s t)
rs 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 Int
l t -> r
f (ResultInfo Int
l' [(s, g (ResultList g s))]
rest' t
a) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' (t -> r
f t
a)
   {-# INLINABLE pure #-}
   {-# INLINABLE (<*>) #-}

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

instance 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 [(i, g (ResultList g i))] -> ResultList g i a
p >>= :: Parser g i a -> (a -> Parser g i b) -> Parser g i b
>>= 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 [(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 BinTree (ResultInfo g i a)
results 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 Int
l [(i, g (ResultList g i))]
rest' 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' Int
l (ResultList BinTree (ResultInfo g s r)
rs 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 Int
l (ResultInfo Int
l' [(s, g (ResultList g s))]
rest' r
a) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') [(s, g (ResultList g s))]
rest' r
a

instance MonadFail (Parser g s) where
   fail :: String -> Parser g s a
fail String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest = BinTree (ResultInfo g s a) -> 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 ([(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
msg])

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 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 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 ((s
_, g (ResultList g s)
d) : [(s, g (ResultList g s))]
_) = g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f g (ResultList g s)
g (GrammarFunctor (Parser g s))
d
      p [(s, g (ResultList g s))]
_ = BinTree (ResultInfo g s a) -> 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
0 [String -> Expected s
forall s. String -> Expected s
Expected String
"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 (Parser g s)
g s
input = (forall a.
 ResultList g s a
 -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (ResultList g s)
-> g (Compose (Compose (ParseResults s) []) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (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 (Parser g s)
g s
input = (forall a. ResultList g s a -> Compose (ParseResults s) [] a)
-> g (ResultList g s) -> g (Compose (ParseResults s) [])
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
 -> Compose (ParseResults s) [] a)
-> (ResultList g s a -> Compose (ParseResults s) [] (s, a))
-> ResultList g s a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure 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 (Parser g s)
g s
input = (s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))])
-> [(s, g (ResultList g s))] -> [s] -> [(s, g (ResultList g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
   where parseTail :: s -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
parseTail s
s [(s, g (ResultList g s))]
parsedTail = [(s, g (ResultList g s))]
parsed
            where parsed :: [(s, g (ResultList g s))]
parsed = (s
s,g (ResultList g s)
d)(s, g (ResultList g s))
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsedTail
                  d :: g (ResultList g s)
d      = (forall a. Parser g s a -> ResultList g s a)
-> g (Parser g s) -> g (ResultList g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((([(s, g (ResultList g s))] -> ResultList g s a)
-> [(s, g (ResultList g s))] -> ResultList g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (ResultList g s))]
parsed) (([(s, g (ResultList g s))] -> ResultList g s a)
 -> ResultList g s a)
-> (Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a)
-> Parser g s a
-> ResultList g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser) g (Parser g s)
g

reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails :: g (Parser g s)
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
reparseTails g (Parser g s)
_ [] = []
reparseTails g (Parser g s)
final parsed :: [(s, g (ResultList g s))]
parsed@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = (s
s, g (ResultList g s)
gd)(s, g (ResultList g s))
-> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
forall a. a -> [a] -> [a]
:[(s, g (ResultList g s))]
parsed
   where gd :: g (ResultList g s)
gd = (forall a. Parser g s a -> ResultList g s a)
-> g (Parser g s) -> g (ResultList g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
`applyParser` [(s, g (ResultList g s))]
parsed) g (Parser g s)
final

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

instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where
   traceInput :: (ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case String -> ResultList g s a -> ResultList g s a
traceWith String
"Parsing " ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
                                of rl :: ResultList g s a
rl@(ResultList BinTree (ResultInfo g s a)
EmptyTree FailureInfo s
_) -> String -> ResultList g s a -> ResultList g s a
traceWith String
"Failed " ResultList g s a
rl
                                   ResultList g s a
rl -> String -> ResultList g s a -> ResultList g s a
traceWith String
"Parsed " ResultList g s a
rl
               where traceWith :: String -> ResultList g s a -> ResultList g s a
traceWith String
prefix = String -> ResultList g s a -> ResultList g s a
forall a. String -> a -> a
trace (String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
ParserInput (Parser g s)
s)

instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s s) -> 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
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
                  Maybe Char
_ -> 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
"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 Int
0 [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfyCharInput"])
   scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s0)
      where p :: state -> [(s, g (ResultList g s))] -> ResultList g s s
p state
s rest :: [(s, g (ResultList g s))]
rest@((s
i, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_) = BinTree (ResultInfo g s s) -> 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 (s
prefix, s
_, state
_) = 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 state
_ [] = 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
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 Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x =
                    BinTree (ResultInfo g s s) -> 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 Int
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 Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s s
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s s
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_) : [(s, g (ResultList g s))]
_)
               | s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Int
l <- s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                    BinTree (ResultInfo g s s) -> 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 [(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
"takeCharsWhile1"])
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s ()
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s ()
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
_)
               | Just Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = BinTree (ResultInfo g s ()) -> 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 String
"notSatisfyChar"])
            p [(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 Int
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 [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
rewindFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where rewindFailure :: ResultList g s a -> ResultList g s a
rewindFailure (ResultList BinTree (ResultInfo g s a)
rl (FailureInfo Int
_pos [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 [(s, g (ResultList g s))] -> ResultList g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg  = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q
      where q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = ResultList g s a -> ResultList g s a
replaceFailure ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
rest)
               where replaceFailure :: ResultList g s a -> ResultList g s a
replaceFailure (ResultList BinTree (ResultInfo g s a)
EmptyTree (FailureInfo Int
pos [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 ResultList g s a
rl = ResultList g s a
rl
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s ()
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s r.
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
      where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s ()
rewind [(s, g (ResultList g s))]
t (ResultList BinTree (ResultInfo g s r)
EmptyTree FailureInfo 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 Int
0 [(s, g (ResultList g s))]
t ()) FailureInfo s
forall a. Monoid a => a
mempty
            rewind [(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 String
"notFollowedBy"])
   skipMany :: Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
      where go :: Parser g s ()
go = () -> Parser g s ()
forall (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 String
msg = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
t-> BinTree (ResultInfo g s a) -> 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, g (ResultList g s)
_):[(s, g (ResultList g 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 Int
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 String
"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 Int
0 [] ()) FailureInfo s
forall a. Monoid a => a
mempty

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

instance MonoidNull s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser [(s, g (ResultList g s))] -> ResultList g s a
p) = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser (\[(s, g (ResultList g s))]
input-> [(s, g (ResultList g s))] -> ResultList g s a -> ResultList g s a
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) r.
[(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s r
rewind [(s, g (ResultList g s))]
input ([(s, g (ResultList g s))] -> ResultList g s a
p [(s, g (ResultList g s))]
input))
      where rewind :: [(s, g (ResultList g s))] -> ResultList g s r -> ResultList g s r
rewind [(s, g (ResultList g s))]
t (ResultList BinTree (ResultInfo g s r)
rl 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 [(s, g (ResultList g s))]
t (ResultInfo Int
_ [(s, g (ResultList g s))]
_ r
r) = Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
forall (g :: (* -> *) -> *) s r.
Int -> [(s, g (ResultList g s))] -> r -> ResultInfo g s r
ResultInfo Int
0 [(s, g (ResultList g s))]
t r
r

instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = ([(s, g (ResultList g s))] -> ResultList g s Char)
-> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s Char
p
      where p :: [(s, g (ResultList g s))] -> ResultList g s Char
p rest :: [(s, g (ResultList g s))]
rest@((s
s, g (ResultList g s)
_):[(s, g (ResultList g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> BinTree (ResultInfo g s Char)
-> 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 Int
1 [(s, g (ResultList g s))]
t Char
first) FailureInfo s
forall a. Monoid a => a
mempty
                  Maybe Char
_ -> 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 String
"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 Int
0 [String -> Expected s
forall s. String -> Expected s
Expected String
"Char.satisfy"])
   string :: String -> Parser g s String
string String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

fromResultList :: (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 (ResultList BinTree (ResultInfo g s r)
EmptyTree (FailureInfo Int
pos [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
+ Int
1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList s
_ (ResultList BinTree (ResultInfo g s r)
rl 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 Int
_ ((a
s, g (ResultList g a)
_):[(a, g (ResultList g a))]
_) b
r) = (a
s, b
r)
         f (ResultInfo Int
_ [] b
r) = (a
forall a. Monoid a => a
mempty, b
r)

-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
-- of input tails, opposite of 'peg'
longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
longest :: Parser g s a -> Parser g [(s, g (ResultList g s))] a
longest Parser g s a
p = ([(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a)
-> Parser g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Backtrack.Parser [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q where
   q :: [(s, g (ResultList g s))] -> Result g [(s, g (ResultList g s))] a
q [(s, g (ResultList g s))]
rest = case Parser g s a -> [(s, g (ResultList g s))] -> ResultList g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (ResultList g s))] -> ResultList g s r
applyParser Parser g s a
p [(s, g (ResultList g s))]
rest
            of ResultList BinTree (ResultInfo g s a)
EmptyTree (FailureInfo Int
pos [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 BinTree (ResultInfo g s a)
rs FailureInfo s
_ -> ResultInfo g s a -> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed ((ResultInfo g s a -> ResultInfo g s a -> Ordering)
-> BinTree (ResultInfo g s a) -> ResultInfo g s a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (ResultInfo g s a -> Int)
-> ResultInfo g s a
-> ResultInfo g s a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ResultInfo g s a -> Int
forall (g :: (* -> *) -> *) s a. ResultInfo g s a -> Int
resultLength) BinTree (ResultInfo g s a)
rs)
   resultLength :: ResultInfo g s r -> Int
resultLength (ResultInfo Int
l [(s, g (ResultList g s))]
_ r
_) = Int
l
   parsed :: ResultInfo g s v -> Result g [(s, g (ResultList g s))] v
parsed (ResultInfo Int
l [(s, g (ResultList g s))]
s v
r) = Int
-> v
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Backtrack.Parsed Int
l v
r [(s, g (ResultList g s))]
s
   message :: Expected a -> Expected [(a, b)]
message (Expected String
msg) = String -> Expected [(a, b)]
forall s. String -> Expected s
Expected String
msg
   message (ExpectedInput a
s) = [(a, b)] -> Expected [(a, b)]
forall s. s -> Expected s
ExpectedInput [(a
s, String -> b
forall a. HasCallStack => String -> a
error String
"longest")]

-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
peg :: 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 Parser g [(s, g (ResultList g s))] a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList g s a
q [(s, g (ResultList g s))]
rest = case Parser g [(s, g (ResultList g s))] a
-> [(s, g (ResultList g s))]
-> Result g [(s, g (ResultList g s))] a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g [(s, g (ResultList g s))] a
p [(s, g (ResultList g s))]
rest
            of Backtrack.Parsed Int
l a
result [(s, g (ResultList g s))]
suffix -> BinTree (ResultInfo g s a) -> 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 Int
pos [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 Parser g s a
p = ([(s, g (ResultList g s))] -> ResultList g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (ResultList g s))] -> ResultList g s r) -> Parser g s r
Parser [(s, g (ResultList g s))] -> ResultList g s a
q where
   q :: [(s, g (ResultList g s))] -> ResultList g s a
q [] = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
forall a. Monoid a => a
mempty
            of Backtrack.Parsed Int
l a
result s
_ -> BinTree (ResultInfo g s a) -> 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 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, g (ResultList g s)
_):[(s, g (ResultList g s))]
_) = case Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
Backtrack.applyParser Parser g s a
p s
s
                       of Backtrack.Parsed Int
l a
result s
_ -> BinTree (ResultInfo g s a) -> 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 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