{-# 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 showsPrecSub :: Int -> a -> ShowS
showsPrecSub _showList :: [a] -> ShowS
_showList prec :: Int
prec Parsed{parsedPrefix :: forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedPrefix= a
r} rest :: String
rest = "Parsed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> a -> ShowS
showsPrecSub Int
prec a
r String
rest
   liftShowsPrec _showsPrec :: Int -> a -> ShowS
_showsPrec _showList :: [a] -> ShowS
_showList _prec :: Int
_prec (NoParse f :: FailureInfo s
f) rest :: String
rest = "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 f :: a -> b
f (Parsed a :: a
a rest :: [(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 _ (NoParse failure :: 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 f :: a -> b
f (Parser p :: [(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
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 p :: [(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 q :: [(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 rest :: [(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 f :: a -> b
f rest' :: [(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 failure :: 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 (\rest :: [(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 "empty"])
   Parser p :: [(s, g (Result g s))] -> Result g s a
p <|> :: Parser g s a -> Parser g s a -> Parser g s a
<|> Parser q :: [(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 rest :: [(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 p :: [(s, g (Result g s))] -> Result g s a
p >>= :: Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= f :: 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 rest :: [(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
a rest' :: [(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 failure :: 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 p :: [(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 rest :: [(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 _pos :: Int
_pos _msgs :: [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 parsed :: Result g s a
parsed = Result g s a
parsed
   Parser p :: [(s, g (Result g s))] -> Result g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> msg :: 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 rest :: [(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 pos :: Int
pos msgs :: [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 parsed :: 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
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 "end of input"])
            p rest :: [(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 msg :: 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 (\t :: [(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 p :: [(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 (\input :: [(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 t :: [(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 "notFollowedBy"])
            rewind t :: [(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 p :: [(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 (\input :: [(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 t :: [(s, g (Result g s))]
t (Parsed r :: v
r _) = 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 _ 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 predicate :: 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
s, _):t :: [(s, g (Result g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: Char
first | Char -> Bool
predicate Char
first -> 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
                  _ -> 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 "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 0 [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
   string :: String -> Parser g s String
string s :: String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text t :: Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

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 f :: 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 ((_, d :: g (Result g s)
d) : _) = g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f g (Result g s)
g (GrammarFunctor (Parser g s))
d
      p _ = 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 0 [String -> Expected s
forall s. String -> Expected s
Expected "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
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
s, _):t :: [(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 (first :: 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
                                   _ -> 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 "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 0 [String -> Expected s
forall s. String -> Expected s
Expected "anyToken"])
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy predicate :: ParserInput (Parser g s) -> Bool
predicate = ([(s, g (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
s, _):t :: [(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 (first :: s
first, _) | 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
                  _ -> 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 "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 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy predicate :: 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
s, _):_)
               | Just (first :: s
first, _) <- 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 "notSatisfy"])
            p rest :: [(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 s0 :: state
s0 f :: 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 s :: state
s ((i :: s
i, _):t :: [(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
- 1) [(s, g (Result g s))]
t)
               where (prefix :: s
prefix, _, _) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (Parser g s) -> Maybe state
f s
i
            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 []
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile predicate :: 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
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 n :: 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
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
== 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 rest :: [(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
$ "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 predicate :: 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
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 rest :: [(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 "takeWhile1"])
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string s :: 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
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 rest :: [(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 predicate :: 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
s, _):t :: [(s, g (Result g s))]
t) =
               case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just first :: Char
first | Char -> Bool
predicate Char
first -> 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
                  _ -> 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 "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 0 [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar predicate :: 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
s, _):_)
               | Just first :: 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 "notSatisfyChar"])
            p rest :: [(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 s0 :: state
s0 f :: 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 s :: state
s ((i :: s
i, _):t :: [(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
- 1) [(s, g (Result g s))]
t)
               where (prefix :: s
prefix, _, _) = state -> (state -> Char -> Maybe state) -> s -> (s, s, state)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
            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 []
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile predicate :: 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
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 predicate :: 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
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 rest :: [(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 "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 :: g (Parser g s)
g input :: 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 :: g (Parser g s)
g input :: 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 :: g (Parser g s)
g input :: 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 parsedTail :: [(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 _ [] = []
reparseTails final :: g (Parser g s)
final parsed :: [(s, g (Result g s))]
parsed@((s :: s
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
s (NoParse (FailureInfo pos :: Int
pos msgs :: [Expected s]
msgs)) =
   ParseFailure s -> ParseResults s (s, r)
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
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
+ 1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResult _ (Parsed prefix :: 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 _ (Parsed prefix :: r
prefix ((s :: s
s, _):_)) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
s, r
prefix)