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

import Control.Applicative (Applicative(..), Alternative(..), liftA2)
import Control.Monad (Monad(..), MonadPlus(..))
#if MIN_VERSION_base(4,13,0)
import Control.Monad (MonadFail(fail))
#endif

import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Factorial(FactorialMonoid)
import Data.Monoid.Textual(TextualMonoid)
import Data.Ord (Down(Down))
import Data.Semigroup (Semigroup(..))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
import Data.String (fromString)
import Debug.Trace (trace)
import Witherable (Filterable(mapMaybe))

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.Input.Position (fromEnd)
import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),
                          InputParsing(..), InputCharParsing(..),
                          GrammarParsing(..), MultiParsing(..),
                          TailsParsing(parseTails), ParseResults, ParseFailure(..), Pos)
import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure,
                             TraceableParsing(..))

data Result g s v = Parsed{forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedPrefix :: !v, 
                           forall (g :: (* -> *) -> *) s v.
Result g s v -> [(s, g (Result g s))]
parsedSuffix :: ![(s, g (Result g s))]}
                  | NoParse {-# UNPACK #-} !(ParseFailure Pos 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{forall (g :: (* -> *) -> *) s r.
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 :: forall a.
(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 " 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 ParseFailure (Down Int) s
f) String
rest = String
"NoParse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows ParseFailure (Down Int) s
f String
rest

instance Functor (Result g s) where
   fmap :: forall a b. (a -> b) -> Result g s a -> Result g s b
fmap a -> b
f (Parsed a
a [(s, g (Result g s))]
rest) = 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 ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure

instance Filterable (Result g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> Result g s a -> Result g s b
mapMaybe a -> Maybe b
f (Parsed a
a [(s, g (Result g s))]
rest) =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length [(s, g (Result g s))]
rest) String
"filter") (forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
`Parsed` [(s, g (Result g s))]
rest) (a -> Maybe b
f a
a)
   mapMaybe a -> Maybe b
_ (NoParse ParseFailure (Down Int) s
failure) = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure
   
instance Functor (Parser g s) where
   fmap :: forall a b. (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) = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f 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 :: forall a. a -> Parser g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (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 <*> :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser [(s, g (Result g s))] -> Result g s a
q = 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 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 ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure

instance Alternative (Parser g s) where
   empty :: forall a. Parser g s a
empty = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
   Parser [(s, g (Result g s))] -> Result g s a
p <|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<|> Parser [(s, g (Result g s))] -> Result g s a
q = 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 Filterable (Parser g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser [(s, g (Result g s))] -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (Result g s))] -> Result g s a
p)
   {-# INLINABLE mapMaybe #-}

instance Monad (Parser g s) where
   return :: forall a. a -> Parser g s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Parser [(s, g (Result g s))] -> Result g s a
p >>= :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = 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' -> 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 ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure

#if MIN_VERSION_base(4,13,0)
instance MonadFail (Parser g s) where
#endif
   fail :: forall a. String -> Parser g s a
fail String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
rest-> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
msg)

instance MonadPlus (Parser g s) where
   mzero :: forall a. Parser g s a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: forall a. Parser g s a -> Parser g s a -> Parser g s a
mplus = 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
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid x => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
   mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance FactorialMonoid s => Parsing (Parser g s) where
   try :: forall a. Parser g s a -> Parser g s a
try (Parser [(s, g (Result g s))] -> Result g s a
p) = 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{} = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(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 <?> :: forall a. Parser g s a -> String -> Parser g s a
<?> String
msg  = 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 ParseFailure (Down Int) s
f) = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s.
Down Int
-> String -> ParseFailure (Down Int) s -> ParseFailure (Down Int) s
replaceExpected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length [(s, g (Result g s))]
rest) String
msg ParseFailure (Down Int) s
f)
                     replaceFailure Result g s a
parsed = Result g s a
parsed
   eof :: Parser g s ()
eof = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser 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 (forall m. MonoidNull m => m -> Bool
Null.null s
s) = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"end of input")
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   unexpected :: forall a. String -> Parser g s a
unexpected String
msg = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
t-> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
t) String
msg)
   notFollowedBy :: forall a. Show a => Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (Result g s))] -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> 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{} = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
t) String
"notFollowedBy")
            rewind [(s, g (Result g s))]
t NoParse{} = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
t

instance FactorialMonoid s => CommittedParsing (Parser g s) where
   type CommittedResults (Parser g s) = ParseResults s
   commit :: forall a.
Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser [(s, g (Result g s))] -> Result g s a
p) = 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 (Either (ParseFailure (Down Int) s) a)
q
      where q :: [(s, g (Result g s))]
-> Result g s (Either (ParseFailure (Down Int) s) a)
q [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
                     of NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure) [(s, g (Result g s))]
rest
                        Parsed a
a [(s, g (Result g s))]
rest' -> forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (forall a b. b -> Either a b
Right a
a) [(s, g (Result g s))]
rest'
   admit :: forall a.
Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser [(s, g (Result g s))]
-> Result g s (CommittedResults (Parser g s) a)
p) = 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 = case [(s, g (Result g s))]
-> Result g s (CommittedResults (Parser g s) a)
p [(s, g (Result g s))]
rest
                     of NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure
                        Parsed (Left ParseFailure (Down Int) s
failure) [(s, g (Result g s))]
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure
                        Parsed (Right a
a) [(s, g (Result g s))]
rest' -> forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed a
a [(s, g (Result g s))]
rest'

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

instance FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: forall a. Parser g s a -> Parser g s a
lookAhead (Parser [(s, g (Result g s))] -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> 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))]
_) = 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 = 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 forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> 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
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"Char.satisfy")
            p [] = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"Char.satisfy")
   string :: String -> Parser g s String
string String
s = forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text Text
t = (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

-- | Packrat parser
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 :: forall a.
ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult = forall a b. a -> b -> a
const forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult
   nonTerminal :: forall (g :: (* -> *) -> *) a.
(g ~ ParserGrammar (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(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 = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> GrammarFunctor (Parser g s) a
p where
      p :: [(s, g (Result g s))] -> GrammarFunctor (Parser 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)
d
      p [(s, g (Result g s))]
_ = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"NonTerminal at endOfInput")
   chainRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainRecursive = forall (m :: * -> *) (g :: (* -> *) -> *) (f :: * -> *) a.
(GrammarParsing m, g ~ ParserGrammar m, f ~ GrammarFunctor m,
 GrammarConstraint m g) =>
(f a -> g f -> g f) -> m a -> m a -> m a
chainLongestRecursive
   chainLongestRecursive :: forall (g :: (* -> *) -> *) (f :: * -> *) a.
(g ~ ParserGrammar (Parser g s), f ~ GrammarFunctor (Parser g s),
 GrammarConstraint (Parser g s) g) =>
(f a -> g f -> g f) -> Parser g s a -> Parser g s a -> Parser g s a
chainLongestRecursive f a -> g f -> g f
assign (Parser [(s, g (Result g s))] -> Result g s a
base) (Parser [(s, g (Result g s))] -> Result g s a
recurse) = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g f)] -> Result g s a
q
      where q :: [(s, g f)] -> Result g s a
q [] = [(s, g (Result g s))] -> Result g s a
base []
            q ((s
s, g f
d):[(s, g f)]
t) = case [(s, g (Result g s))] -> Result g s a
base [(s, g f)]
initialInput
                           of r :: Result g s a
r@NoParse{} -> Result g s a
r
                              Result g s a
r -> Result g s a -> f a
iter Result g s a
r
               where iter :: Result g s a -> f a
iter f a
r = case [(s, g (Result g s))] -> Result g s a
recurse ((s
s, f a -> g f -> g f
assign f a
r g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t)
                              of NoParse{} -> f a
r
                                 r' :: Result g s a
r'@Parsed{} -> Result g s a -> f a
iter Result g s a
r'
                     initialInput :: [(s, g f)]
initialInput = (s
s, f a -> g f -> g f
assign (forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse forall s. ParseFailure (Down Int) s
noFailure) g f
d) forall a. a -> [a] -> [a]
: [(s, g f)]
t

instance (Eq s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
   parseTails :: forall (g :: (* -> *) -> *) r.
GrammarConstraint (Parser g s) g =>
Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = 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 = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser 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))]
_) = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
s [(s, g (Result g s))]
rest
            p [] = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed forall a. Monoid a => a
mempty []
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser 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 forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                                of Just (s
first, 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)
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"anyToken")
            p [] = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"anyToken")
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = 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 forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
               of Just (s
first, s
_) | ParserInput (Parser g s) -> Bool
predicate s
first -> 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)
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"satisfy")
            p [] = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfy")
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = 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
_) <- forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s, 
                 ParserInput (Parser g s) -> Bool
predicate s
first = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"notSatisfy")
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   scan :: forall state.
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 = 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) = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (forall a. Int -> [a] -> [a]
drop (forall m. Factorial m => m -> Int
Factorial.length s
prefix forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
               where (s
prefix, s
_, state
_) = forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> ParserInput (Parser g s) -> Maybe state
f s
i
            p state
_ [] = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed 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 = 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 <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [] = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed forall a. Monoid a => a
mempty []
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = 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 <- forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, forall m. Factorial m => m -> Int
Factorial.length s
x forall a. Eq a => a -> a -> Bool
== Int
n = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (forall a. Int -> [a] -> [a]
drop Int
n [(s, g (Result g s))]
rest)
            p [] | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed forall a. Monoid a => a
mempty []
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ 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 = 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 <- forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile ParserInput (Parser g s) -> Bool
predicate s
s, Bool -> Bool
not (forall m. MonoidNull m => m -> Bool
Null.null s
x) =
                    forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"takeWhile1")
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (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))]
_)
         | ParserInput (Parser g s)
s forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed ParserInput (Parser g s)
s (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length ParserInput (Parser g s)
s) [(s, g (Result g s))]
rest)
      p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> s -> ParseFailure (Down Int) s
expectedInput (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) ParserInput (Parser g s)
s)

instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where
   traceInput :: forall a.
(ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser [(s, g (Result g s))] -> Result g s a
p) = 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
              | let input :: s
input = case [(s, g (Result g s))]
rest
                            of ((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) -> s
s
                               [] -> forall a. Monoid a => a
mempty
                    traceWith :: String -> Result g s a -> Result g s a
traceWith String
prefix = forall a. String -> a -> a
trace (String
prefix forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
input)
              = case String -> Result g s a -> Result g s a
traceWith String
"Parsing " ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
                  of r :: Result g s a
r@Parsed{}
                        | let prefix :: s
prefix = forall m. FactorialMonoid m => Int -> m -> m
Factorial.take (forall m. Factorial m => m -> Int
Factorial.length s
input forall a. Num a => a -> a -> a
- forall m. Factorial m => m -> Int
Factorial.length (forall (g :: (* -> *) -> *) s v.
Result g s v -> [(s, g (Result g s))]
parsedSuffix Result g s a
r)) s
input
                        -> forall a. String -> a -> a
trace (String
"Parsed " forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
prefix) Result g s a
r
                     r :: Result g s a
r@NoParse{} -> String -> Result g s a -> Result g s a
traceWith String
"Failed " Result g s a
r

instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = 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 forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
               of Just Char
first | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (forall m. Factorial m => m -> m
Factorial.primePrefix s
s) [(s, g (Result g s))]
t
                  Maybe Char
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"satisfyCharInput")
            p [] = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected Down Int
0 String
"satisfyCharInput")
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s, 
                 Char -> Bool
predicate Char
first = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"notSatisfyChar")
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
   scanChars :: forall state.
state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = 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) = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (forall a. Int -> [a] -> [a]
drop (forall m. Factorial m => m -> Int
Factorial.length s
prefix forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
               where (s
prefix, 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
_ [] = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed forall a. Monoid a => a
mempty []
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s =
                    forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [] = forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed forall a. Monoid a => a
mempty []
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = 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 <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Bool -> Bool
not (forall m. MonoidNull m => m -> Bool
Null.null s
x) =
                    forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (forall a. Int -> [a] -> [a]
drop (forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
            p [(s, g (Result g s))]
rest = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) 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 :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
 Eq s, FactorialMonoid s) =>
g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g s
input)
   parseComplete :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
 Eq s, FactorialMonoid s) =>
g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult)
                                      (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g s
input)
      where close :: g (Parser g s)
close = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 :: forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g s
input = 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 [] (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)forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsedTail
               d :: g (Result g s)
d      = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))]
parsed) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (g :: (* -> *) -> *) s.
Functor g =>
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)forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsed
   where gd :: g (Result g s)
gd = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (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, Monoid s) => Result g s r -> ParseResults s (s, r)
fromResult :: forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult (NoParse (ParseFailure Down Int
pos FailureDescription s
positive [String]
negative)) = forall a b. a -> Either a b
Left (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Down Int
pos forall a. Num a => a -> a -> a
- Down Int
1) FailureDescription s
positive [String]
negative)
fromResult (Parsed r
prefix []) = forall a b. b -> Either a b
Right (forall a. Monoid a => a
mempty, r
prefix)
fromResult (Parsed r
prefix ((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)) = forall a b. b -> Either a b
Right (s
s, r
prefix)