{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
-- | Packrat parser
module Text.Grampa.PEG.Packrat (Parser(..), Result(..)) where

import Control.Applicative (Applicative(..), Alternative(..), liftA2)
import Control.Monad (Monad(..), MonadPlus(..))

import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (genericLength, nub)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Factorial(FactorialMonoid)
import Data.Monoid.Textual(TextualMonoid)
import Data.Semigroup (Semigroup(..))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)

import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Null as Null
import qualified Data.Monoid.Textual as Textual

import qualified Rank2

import qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.LookAhead (LookAheadParsing(..))
import Text.Grampa.Class (DeterministicParsing(..), InputParsing(..), InputCharParsing(..),
                          GrammarParsing(..), MultiParsing(..),
                          TailsParsing(parseTails), ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (FailureInfo(..))

data Result g s v = Parsed{Result g s v -> v
parsedPrefix :: !v, 
                           Result g s v -> [(s, g (Result g s))]
parsedSuffix :: ![(s, g (Result g s))]}
                  | NoParse (FailureInfo s)

-- | Parser type for Parsing Expression Grammars that uses an improved packrat algorithm, with O(1) performance bounds
-- but with worse constants and more memory consumption than the backtracking 'Text.Grampa.PEG.Backtrack.Parser'. The
-- 'parse' function returns an input prefix parse paired with the remaining input suffix.
newtype Parser g s r = Parser{Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser :: [(s, g (Result g s))] -> Result g s r}

instance Show s => Show1 (Result g s) where
   liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Result g s a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecSub [a] -> ShowS
_showList Int
prec Parsed{parsedPrefix :: forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedPrefix= a
r} String
rest = String
"Parsed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> a -> ShowS
showsPrecSub Int
prec a
r String
rest
   liftShowsPrec Int -> a -> ShowS
_showsPrec [a] -> ShowS
_showList Int
_prec (NoParse FailureInfo s
f) String
rest = String
"NoParse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f String
rest

instance Functor (Result g s) where
   fmap :: (a -> b) -> Result g s a -> Result g s b
fmap a -> b
f (Parsed a
a [(s, g (Result g s))]
rest) = b -> [(s, g (Result g s))] -> Result g s b
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (a -> b
f a
a) [(s, g (Result g s))]
rest
   fmap a -> b
_ (NoParse FailureInfo s
failure) = FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
   
instance Functor (Parser g s) where
   fmap :: (a -> b) -> Parser g s a -> Parser g s b
fmap a -> b
f (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser ((a -> b) -> Result g s a -> Result g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result g s a -> Result g s b)
-> ([(s, g (Result g s))] -> Result g s a)
-> [(s, g (Result g s))]
-> Result g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (Result g s))] -> Result g s a
p)

instance Applicative (Parser g s) where
   pure :: a -> Parser g s a
pure a
a = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (a -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed a
a)
   Parser [(s, g (Result g s))] -> Result g s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser [(s, g (Result g s))] -> Result g s a
q = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s b
r where
      r :: [(s, g (Result g s))] -> Result g s b
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s (a -> b)
p [(s, g (Result g s))]
rest
               of Parsed a -> b
f [(s, g (Result g s))]
rest' -> a -> b
f (a -> b) -> Result g s a -> Result g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest'
                  NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure

instance Alternative (Parser g s) where
   empty :: Parser g s a
empty = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
rest-> FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s a) -> FailureInfo s -> Result 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 (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"empty"])
   Parser [(s, g (Result g s))] -> Result g s a
p <|> :: Parser g s a -> Parser g s a -> Parser g s a
<|> Parser [(s, g (Result g s))] -> Result g s a
q = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
r where
      r :: [(s, g (Result g s))] -> Result g s a
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
               of x :: Result g s a
x@Parsed{} -> Result g s a
x
                  NoParse{} -> [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest

instance Monad (Parser g s) where
   return :: a -> Parser g s a
return = a -> Parser g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Parser [(s, g (Result g s))] -> Result g s a
p >>= :: Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s b
r where
      r :: [(s, g (Result g s))] -> Result g s b
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
               of Parsed a
a [(s, g (Result g s))]
rest' -> Parser g s b -> [(s, g (Result g s))] -> Result g s b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser (a -> Parser g s b
f a
a) [(s, g (Result g s))]
rest'
                  NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure

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 FactorialMonoid s => Parsing (Parser g s) where
   try :: Parser g s a -> Parser g s a
try (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
      where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = Result g s a -> Result g s a
rewindFailure ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
               where rewindFailure :: Result g s a -> Result g s a
rewindFailure (NoParse (FailureInfo Int
_pos [Expected s]
_msgs)) = FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [])
                     rewindFailure Result g s a
parsed = Result g s a
parsed
   Parser [(s, g (Result g s))] -> Result g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg  = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
      where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = Result g s a -> Result g s a
replaceFailure ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
               where replaceFailure :: Result g s a -> Result g s a
replaceFailure (NoParse (FailureInfo Int
pos [Expected s]
msgs)) =
                        FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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 (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest then [String -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
msgs)
                     replaceFailure Result g s a
parsed = Result g s a
parsed
   eof :: Parser g s ()
eof = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
forall s (g :: (* -> *) -> *).
MonoidNull s =>
[(s, g (Result g s))] -> Result g s ()
p
      where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
               | Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
s) = FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"end of input"])
            p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   unexpected :: String -> Parser g s a
unexpected String
msg = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
t-> FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s a) -> FailureInfo s -> Result 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 (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> [(s, g (Result g s))] -> Result g s a -> Result g s ()
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s v.
[(s, g (Result g s))] -> Result g s v -> Result g s ()
rewind [(s, g (Result g s))]
input ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
input))
      where rewind :: [(s, g (Result g s))] -> Result g s v -> Result g s ()
rewind [(s, g (Result g s))]
t Parsed{} = FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
t) [String -> Expected s
forall s. String -> Expected s
Expected String
"notFollowedBy"])
            rewind [(s, g (Result g s))]
t NoParse{} = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
t

-- | Every PEG parser is deterministic all the time.
instance FactorialMonoid s => DeterministicParsing (Parser g s) where
   <<|> :: Parser g s a -> Parser g s a -> Parser g s a
(<<|>) = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
   takeSome :: Parser g s a -> Parser g s [a]
takeSome = Parser g s a -> Parser g s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
   takeMany :: Parser g s a -> Parser g s [a]
takeMany = Parser g s a -> Parser g s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
   skipAll :: Parser g s a -> Parser g s ()
skipAll = Parser g s a -> Parser g s ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany

instance FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> [(s, g (Result g s))] -> Result g s a -> Result g s a
forall s (g :: (* -> *) -> *) v.
[(s, g (Result g s))] -> Result g s v -> Result g s v
rewind [(s, g (Result g s))]
input ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
input))
      where rewind :: [(s, g (Result g s))] -> Result g s v -> Result g s v
rewind [(s, g (Result g s))]
t (Parsed v
r [(s, g (Result g s))]
_) = v -> [(s, g (Result g s))] -> Result g s v
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed v
r [(s, g (Result g s))]
t
            rewind [(s, g (Result g s))]
_ r :: Result g s v
r@NoParse{} = Result g s v
r

instance (Show s, Textual.TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s Char) -> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s Char
p
      where p :: [(s, g (Result g s))] -> Result g s Char
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result 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 -> Char -> [(s, g (Result g s))] -> Result g s Char
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed Char
first [(s, g (Result g s))]
t
                  Maybe Char
_ -> FailureInfo s -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"Char.satisfy"])
            p [] = FailureInfo s -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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)

instance (Eq s, LeftReductive s, FactorialMonoid s) => GrammarParsing (Parser g s) where
   type ParserGrammar (Parser g s) = g
   type GrammarFunctor (Parser g s) = Result 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)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> Result g s r -> ParseResults s (s, r)
fromResult
   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 (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
p where
      p :: [(s, g (Result g s))] -> Result g s a
p ((s
_, g (Result g s)
d) : [(s, g (Result g s))]
_) = g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f g (Result g s)
g (GrammarFunctor (Parser g s))
d
      p [(s, g (Result g s))]
_ = FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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"])

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 (Result g s))] -> Result g s r
applyParser

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 (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
forall s (g :: (* -> *) -> *).
Monoid s =>
[(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
s [(s, g (Result g s))]
rest
            p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
forall s (g :: (* -> *) -> *).
FactorialMonoid s =>
[(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                                of Just (s
first, s
_) -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
first [(s, g (Result g s))]
t
                                   Maybe (s, s)
_ -> FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"anyToken"])
            p [] = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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
"anyToken"])
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) =
               case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
               of Just (s
first, s
_) | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
first [(s, g (Result g s))]
t
                  Maybe (s, s)
_ -> FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfy"])
            p [] = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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"])
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
p
      where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)
               | Just (s
first, s
_) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first = FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfy"])
            p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   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 (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (state -> [(s, g (Result g s))] -> Result g s s
p state
s0)
      where p :: state -> [(s, g (Result g s))] -> Result g s s
p state
s ((s
i, g (Result g s)
_):[(s, g (Result g s))]
t) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
               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
            p state
_ [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result 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 = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
               | s
x <- Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop Int
n [(s, g (Result g s))]
rest)
            p [] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
            p [(s, g (Result g s))]
rest = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result 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])
   takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result 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, Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
x) =
                    s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [(s, g (Result g s))]
rest = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result 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 (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p where
      p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s', g (Result g s)
_) : [(s, g (Result g s))]
_)
         | s
ParserInput (Parser g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
ParserInput (Parser g s)
s (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s) [(s, g (Result g s))]
rest)
      p [(s, g (Result g s))]
rest = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [s -> Expected s
forall s. s -> Expected s
ExpectedInput 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 (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result 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 -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) [(s, g (Result g s))]
t
                  Maybe Char
_ -> FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfyCharInput"])
            p [] = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (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"])
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
p
      where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)
               | Just Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfyChar"])
            p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (state -> [(s, g (Result g s))] -> Result g s s
p state
s0)
      where p :: state -> [(s, g (Result g s))] -> Result g s s
p state
s ((s
i, g (Result g s)
_):[(s, g (Result g s))]
t) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
               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
            p state
_ [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result 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 =
                    s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
      where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result 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, Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
x) =
                    s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [(s, g (Result g s))]
rest = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeCharsWhile1"])

-- | Packrat parser
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Packrat.'Parser' g s) -> s -> g ('ParseResults' s)
-- @
instance (LeftReductive s, FactorialMonoid s) => MultiParsing (Parser g s) where
   type ResultFunctor (Parser g s) = ParseResults s
   type GrammarConstraint (Parser g s) g' = (g ~ g', Rank2.Functor g)
   {-# NOINLINE parsePrefix #-}
   parsePrefix :: g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = (forall a. Result g s a -> Compose (ParseResults s) ((,) s) a)
-> g (Result g s) -> g (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 (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)
-> (Result g s a -> Either (ParseFailure s) (s, a))
-> Result g s a
-> Compose (Either (ParseFailure s)) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either (ParseFailure s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> Result g s r -> ParseResults s (s, r)
fromResult s
input) ((s, g (Result g s)) -> g (Result g s)
forall a b. (a, b) -> b
snd ((s, g (Result g s)) -> g (Result g s))
-> (s, g (Result g s)) -> g (Result g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> (s, g (Result g s))
forall a. [a] -> a
head ([(s, g (Result g s))] -> (s, g (Result g s)))
-> [(s, g (Result g s))] -> (s, g (Result g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
   parseComplete :: g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = (forall a. Result g s a -> ParseResults s a)
-> g (Result g s) -> g (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)
-> Either (ParseFailure s) (s, a) -> Either (ParseFailure s) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either (ParseFailure s) (s, a) -> Either (ParseFailure s) a)
-> (Result g s a -> Either (ParseFailure s) (s, a))
-> Result g s a
-> Either (ParseFailure s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either (ParseFailure s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> Result g s r -> ParseResults s (s, r)
fromResult s
input)
                                      ((s, g (Result g s)) -> g (Result g s)
forall a b. (a, b) -> b
snd ((s, g (Result g s)) -> g (Result g s))
-> (s, g (Result g s)) -> g (Result g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> (s, g (Result g s))
forall a. [a] -> a
head ([(s, g (Result g s))] -> (s, g (Result g s)))
-> [(s, g (Result g s))] -> (s, g (Result g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails g (Parser g s)
close ([(s, g (Result g s))] -> [(s, g (Result g s))])
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
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 (Result g s))]
parseGrammarTails :: g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g s
input = (s -> [(s, g (Result g s))] -> [(s, g (Result g s))])
-> [(s, g (Result g s))] -> [s] -> [(s, g (Result g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (Result g s))] -> [(s, g (Result g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
      where parseTail :: s -> [(s, g (Result g s))] -> [(s, g (Result g s))]
parseTail s
s [(s, g (Result g s))]
parsedTail = [(s, g (Result g s))]
parsed where
               parsed :: [(s, g (Result g s))]
parsed = (s
s,g (Result g s)
d)(s, g (Result g s))
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsedTail
               d :: g (Result g s)
d      = (forall a. Parser g s a -> Result g s a)
-> g (Parser g s) -> g (Result 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 (Result g s))] -> Result g s a)
-> [(s, g (Result g s))] -> Result g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))]
parsed) (([(s, g (Result g s))] -> Result g s a) -> Result g s a)
-> (Parser g s a -> [(s, g (Result g s))] -> Result g s a)
-> Parser g s a
-> Result g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser g s a -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser) g (Parser g s)
g

reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails :: g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails g (Parser g s)
_ [] = []
reparseTails g (Parser g s)
final parsed :: [(s, g (Result g s))]
parsed@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) = (s
s, g (Result g s)
gd)(s, g (Result g s))
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsed
   where gd :: g (Result g s)
gd = (forall a. Parser g s a -> Result g s a)
-> g (Parser g s) -> g (Result 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 (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
`applyParser` [(s, g (Result g s))]
parsed) g (Parser g s)
final

fromResult :: (Eq s, FactorialMonoid s) => s -> Result g s r -> ParseResults s (s, r)
fromResult :: s -> Result g s r -> ParseResults s (s, r)
fromResult s
s (NoParse (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
Factorial.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))
fromResult s
_ (Parsed r
prefix []) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
forall a. Monoid a => a
mempty, r
prefix)
fromResult s
_ (Parsed r
prefix ((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
s, r
prefix)