{-# 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.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Factorial(FactorialMonoid)
import Data.Monoid.Textual(TextualMonoid)
import Data.String (fromString)

import qualified Data.Monoid.Cancellative as Cancellative
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.Parser.Token (TokenParsing)
import qualified Text.Parser.Token
import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..), 
                          ParseResults, ParseFailure(..))
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

-- | 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 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
f) rest :: String
rest = "NoParse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo
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
failure) = FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
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
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
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 -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (FailureInfo -> Result g s a) -> FailureInfo -> Result g s a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["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
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
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 Factorial.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 :: [String]
_msgs)) = FailureInfo -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
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 :: [String]
msgs)) =
                        FailureInfo -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo Int
pos ([String] -> FailureInfo) -> [String] -> FailureInfo
forall a b. (a -> b) -> a -> b
$ if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest then [String
msg] else [String]
msgs)
                     replaceFailure parsed :: Result g s a
parsed = Result g s a
parsed
   eof :: Parser g s ()
eof = Parser g s ()
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput
   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 -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (FailureInfo -> Result g s a) -> FailureInfo -> Result g s a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
t) [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 -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
t) ["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

instance Factorial.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 = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar
   string :: String -> Parser g s String
string s :: String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   char :: Char -> Parser g s Char
char = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
   notChar :: Char -> Parser g s Char
notChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
   anyChar :: Parser g s Char
anyChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
   text :: Text -> Parser g s Text
text t :: Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error "unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
   someSpace :: Parser g s ()
someSpace = Parser g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
someLexicalSpace
   semi :: Parser g s Char
semi = Parser g s Char
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s Char
lexicalSemicolon
   token :: Parser g s a -> Parser g s a
token = Parser g s a -> Parser g s a
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
       a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken

instance GrammarParsing Parser where
   type GrammarFunctor Parser = Result
   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 (GrammarFunctor Parser g s)
g (Result g s)
d
      p _ = FailureInfo -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo 0 ["NonTerminal at endOfInput"])

instance MonoidParsing (Parser g) where
   endOfInput :: Parser g s ()
endOfInput = ([(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 -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["endOfInput"])
            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
   getInput :: Parser g s 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 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 -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["anyToken"])
            p [] = FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo 0 ["anyToken"])
   satisfy :: (s -> Bool) -> Parser g s s
satisfy predicate :: 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, _) | s -> Bool
predicate 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 -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["satisfy"])
            p [] = FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfy"])
   satisfyChar :: (Char -> Bool) -> Parser g s Char
satisfyChar 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 -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["satisfyChar"])
            p [] = FailureInfo -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyChar"])
   satisfyCharInput :: (Char -> Bool) -> Parser g s 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 -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["satisfyChar"])
            p [] = FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo 0 ["satisfyChar"])
   notSatisfy :: (s -> Bool) -> Parser g s ()
notSatisfy predicate :: 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, 
                 s -> Bool
predicate s
first = FailureInfo -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["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
   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 -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["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
   scan :: s -> (s -> t -> Maybe s) -> Parser g t t
scan s0 :: s
s0 f :: s -> t -> Maybe s
f = ([(t, g (Result g t))] -> Result g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (s -> [(t, g (Result g t))] -> Result g t t
p s
s0)
      where p :: s -> [(t, g (Result g t))] -> Result g t t
p s :: s
s ((i :: t
i, _):t :: [(t, g (Result g t))]
t) = t -> [(t, g (Result g t))] -> Result g t t
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed t
prefix (Int -> [(t, g (Result g t))] -> [(t, g (Result g t))]
forall a. Int -> [a] -> [a]
drop (t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [(t, g (Result g t))]
t)
               where (prefix :: t
prefix, _, _) = s -> (s -> t -> Maybe s) -> t -> (t, t, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s s -> t -> Maybe s
f t
i
            p _ [] = t -> [(t, g (Result g t))] -> Result g t t
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed t
forall a. Monoid a => a
mempty []
   scanChars :: s -> (s -> Char -> Maybe s) -> Parser g t t
scanChars s0 :: s
s0 f :: s -> Char -> Maybe s
f = ([(t, g (Result g t))] -> Result g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (s -> [(t, g (Result g t))] -> Result g t t
p s
s0)
      where p :: s -> [(t, g (Result g t))] -> Result g t t
p s :: s
s ((i :: t
i, _):t :: [(t, g (Result g t))]
t) = t -> [(t, g (Result g t))] -> Result g t t
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed t
prefix (Int -> [(t, g (Result g t))] -> [(t, g (Result g t))]
forall a. Int -> [a] -> [a]
drop (t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [(t, g (Result g t))]
t)
               where (prefix :: t
prefix, _, _) = s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s s -> Char -> Maybe s
f t
i
            p _ [] = t -> [(t, g (Result g t))] -> Result g t t
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed t
forall a. Monoid a => a
mempty []
   takeWhile :: (s -> Bool) -> Parser g s s
takeWhile predicate :: 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
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 []
   takeWhile1 :: (s -> Bool) -> Parser g s s
takeWhile1 predicate :: 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
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 -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["takeWhile1"])
   takeCharsWhile :: (Char -> Bool) -> Parser g s 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 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 -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["takeCharsWhile1"])
   string :: s -> Parser g s s
string s :: 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 -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
Cancellative.isPrefixOf s
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 (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
s) [(s, g (Result g s))]
rest)
      p rest :: [(s, g (Result g s))]
rest = FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo ([(s, g (Result g s))] -> Int
forall i a. Num i => [a] -> i
genericLength [(s, g (Result g s))]
rest) ["string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s])
   concatMany :: Parser g s a -> Parser g s a
concatMany p :: Parser g s a
p = Parser g s a
go
      where go :: Parser g s a
go = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> Parser g s a -> Parser g s (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p Parser g s (a -> a) -> Parser g s a -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser g s a
go Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser g s a
forall a. Monoid a => a
mempty


-- | Packrat parser
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Packrat.'Parser' g s) -> s -> g 'ParseResults'
-- @
instance MultiParsing Parser where
   type ResultFunctor Parser = ParseResults
   {-# NOINLINE parsePrefix #-}
   parsePrefix :: g (Parser g s) -> s -> g (Compose (ResultFunctor Parser) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a. Result g s a -> Compose ParseResults ((,) s) a)
-> g (Result g s) -> g (Compose ParseResults ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Either ParseFailure (s, a) -> Compose ParseResults ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure (s, a) -> Compose ParseResults ((,) s) a)
-> (Result g s a -> Either ParseFailure (s, a))
-> Result g s a
-> Compose ParseResults ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either ParseFailure (s, a)
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> Result g s r -> ParseResults (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))]
parseTails g (Parser g s)
g s
input)
   parseComplete :: g (Parser g s) -> s -> g (ResultFunctor Parser)
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a. Result g s a -> ParseResults a)
-> g (Result g s) -> g ParseResults
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Either ParseFailure (s, a) -> Either ParseFailure a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either ParseFailure (s, a) -> Either ParseFailure a)
-> (Result g s a -> Either ParseFailure (s, a))
-> Result g s a
-> Either ParseFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either ParseFailure (s, a)
forall s (g :: (* -> *) -> *) r.
FactorialMonoid s =>
s -> Result g s r -> ParseResults (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))]
parseTails g (Parser g s)
g s
input)
      where close :: g (Parser g s)
close = (forall a. Parser g s a -> Parser g s a)
-> g (Parser g s) -> g (Parser g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Parser g s a -> Parser g s () -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser g s ()
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput) g (Parser g s)
g

parseTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (Result g s))]
parseTails :: g (Parser g s) -> s -> [(s, g (Result g s))]
parseTails 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 :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)
fromResult :: s -> Result g s r -> ParseResults (s, r)
fromResult s :: s
s (NoParse (FailureInfo pos :: Int
pos msgs :: [String]
msgs)) =
   ParseFailure -> ParseResults (s, r)
forall a b. a -> Either a b
Left (Int -> [String] -> ParseFailure
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
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) ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
msgs))
fromResult _ (Parsed prefix :: r
prefix []) = (s, r) -> ParseResults (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, r)
forall a b. b -> Either a b
Right (s
s, r
prefix)