{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, UndecidableInstances #-}
-- | Backtracking parser for Parsing Expression Grammars
module Text.Grampa.PEG.Backtrack (Parser(..), Result(..), alt) 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.Kind (Type)
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 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 Data.Semigroup.Cancellative as Cancellative

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(..), MultiParsing(..),
                          ParseResults, ParseFailure(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (expected, TraceableParsing(..))

data Result (g :: (Type -> Type) -> Type) s v =
     Parsed{Result g s v -> v
parsedPrefix :: !v,
            Result g s v -> s
parsedSuffix :: !s}
   | NoParse (ParseFailure Pos s)

-- | Parser type for Parsing Expression Grammars that uses a backtracking algorithm, fast for grammars in LL(1) class
-- but with potentially exponential performance for longer ambiguous prefixes.
newtype Parser g s r = Parser{Parser g s r -> s -> Result g s r
applyParser :: s -> Result g s r}

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

instance Functor (Result g s) where
   fmap :: (a -> b) -> Result g s a -> Result g s b
fmap a -> b
f (Parsed a
a s
rest) = b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (a -> b
f a
a) s
rest
   fmap a -> b
_ (NoParse ParseFailure Pos s
failure) = ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure

instance Factorial.FactorialMonoid s => Filterable (Result g s) where
   mapMaybe :: (a -> Maybe b) -> Result g s a -> Result g s b
mapMaybe a -> Maybe b
f (Parsed a
a s
rest) =
      Result g s b -> (b -> Result g s b) -> Maybe b -> Result g s b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s b)
-> ParseFailure Pos s -> Result g s b
forall a b. (a -> b) -> a -> b
$ Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"filter") (b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
`Parsed` s
rest) (a -> Maybe b
f a
a)
   mapMaybe a -> Maybe b
_ (NoParse ParseFailure Pos s
failure) = ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
   
instance Functor (Parser g s) where
   fmap :: (a -> b) -> Parser g s a -> Parser g s b
fmap a -> b
f (Parser s -> Result g s a
p) = (s -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(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 -> Result g s a) -> s -> Result g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a
p)
   {-# INLINABLE fmap #-}

instance Applicative (Parser g s) where
   pure :: a -> Parser g s a
pure a
a = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed a
a)
   Parser s -> Result g s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser s -> Result g s a
q = (s -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s b
r where
      r :: s -> Result g s b
r s
rest = case s -> Result g s (a -> b)
p s
rest
               of Parsed a -> b
f 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 -> Result g s a
q s
rest'
                  NoParse ParseFailure Pos s
failure -> ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
   {-# INLINABLE (<*>) #-}

instance Factorial.FactorialMonoid s => Alternative (Parser g s) where
   empty :: Parser g s a
empty = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
rest-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [] [])
   <|> :: 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 (g :: (* -> *) -> *) s a.
Parser g s a -> Parser g s a -> Parser g s a
alt

-- | A named and unconstrained version of the '<|>' operator
alt :: Parser g s a -> Parser g s a -> Parser g s a
Parser s -> Result g s a
p alt :: Parser g s a -> Parser g s a -> Parser g s a
`alt` Parser s -> Result g s a
q = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s a
r where
      r :: s -> Result g s a
r s
rest = case s -> Result g s a
p s
rest
               of x :: Result g s a
x@Parsed{} -> Result g s a
x
                  NoParse{} -> s -> Result g s a
q s
rest
   
instance Factorial.FactorialMonoid s => Filterable (Parser g s) where
   mapMaybe :: (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser s -> Result g s a
p) = (s -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser ((a -> Maybe b) -> Result g s a -> Result g s b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f (Result g s a -> Result g s b)
-> (s -> Result g s a) -> s -> Result g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a
p)
   {-# INLINABLE mapMaybe #-}

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

#if MIN_VERSION_base(4,13,0)
instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where
   fail :: String -> Parser g s a
fail String
msg = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
rest-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])
#endif

instance Factorial.FactorialMonoid s => 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 = Parser g s x -> Parser g s x -> Parser g s x
forall a. Semigroup a => a -> a -> a
(<>)

instance Factorial.FactorialMonoid s => Parsing (Parser g s) where
   try :: Parser g s a -> Parser g s a
try (Parser s -> Result g s a
p) = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s a
q
      where q :: s -> Result g s a
q s
rest = Result g s a -> Result g s a
rewindFailure (s -> Result g s a
p s
rest)
               where rewindFailure :: Result g s a -> Result g s a
rewindFailure NoParse{} = ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [] [])
                     rewindFailure Result g s a
parsed = Result g s a
parsed
   Parser s -> Result g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg  = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s a
q
      where q :: s -> Result g s a
q s
rest = Result g s a -> Result g s a
replaceFailure (s -> Result g s a
p s
rest)
               where replaceFailure :: Result g s a -> Result g s a
replaceFailure (NoParse (ParseFailure Pos
pos [FailureDescription s]
msgs [FailureDescription s]
_)) =
                        ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos
                                              (if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Pos
fromEnd (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) then [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg]
                                               else [FailureDescription s]
msgs)
                                              [])
                     replaceFailure Result g s a
parsed = Result g s a
parsed
   eof :: Parser g s ()
eof = (s -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s ()
forall m (g :: (* -> *) -> *).
(MonoidNull m, Factorial m) =>
m -> Result g m ()
p
      where p :: m -> Result g m ()
p m
rest
               | m -> Bool
forall m. MonoidNull m => m -> Bool
Null.null m
rest = () -> m -> Result g m ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () m
rest
               | Bool
otherwise = ParseFailure Pos m -> Result g m ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription m]
-> [FailureDescription m]
-> ParseFailure Pos m
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest)
                                                   [String -> FailureDescription m
forall s. String -> FailureDescription s
StaticDescription String
"end of input"] [])
   unexpected :: String -> Parser g s a
unexpected String
msg = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
t-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser s -> Result g s a
p) = (s -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
input-> s -> Result g s a -> Result g s ()
forall s (g :: (* -> *) -> *) s v (g :: (* -> *) -> *).
Factorial s =>
s -> Result g s v -> Result g s ()
rewind s
input (s -> Result g s a
p s
input))
      where rewind :: s -> Result g s v -> Result g s ()
rewind s
t Parsed{} = ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) String
"notFollowedBy")
            rewind s
t NoParse{} = () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
t

instance FactorialMonoid s => CommittedParsing (Parser g s) where
   type CommittedResults (Parser g s) = ParseResults s
   commit :: Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser s -> Result g s a
p) = (s -> Result g s (Either (ParseFailure Pos s) a))
-> Parser g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s (Either (ParseFailure Pos s) a)
q
      where q :: s -> Result g s (Either (ParseFailure Pos s) a)
q s
rest = case s -> Result g s a
p s
rest
                     of NoParse ParseFailure Pos s
failure -> Either (ParseFailure Pos s) a
-> s -> Result g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (ParseFailure Pos s -> Either (ParseFailure Pos s) a
forall a b. a -> Either a b
Left ParseFailure Pos s
failure) s
rest
                        Parsed a
a s
rest' -> Either (ParseFailure Pos s) a
-> s -> Result g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (a -> Either (ParseFailure Pos s) a
forall a b. b -> Either a b
Right a
a) s
rest'
   admit :: Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser s -> Result g s (CommittedResults (Parser g s) a)
p) = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s a
q
      where q :: s -> Result g s a
q s
rest = case s -> Result g s (CommittedResults (Parser g s) a)
p s
rest
                     of NoParse ParseFailure Pos s
failure -> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
                        Parsed (Left failure) s
_ -> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
                        Parsed (Right a) s
rest' -> a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed a
a s
rest'

-- | 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 (g :: (* -> *) -> *) s a.
Parser g s a -> Parser g s a -> Parser g s a
alt
   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 Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser s -> Result g s a
p) = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
input-> s -> Result g s a -> Result g s a
forall s (g :: (* -> *) -> *) v. s -> Result g s v -> Result g s v
rewind s
input (s -> Result g s a
p s
input))
      where rewind :: s -> Result g s v -> Result g s v
rewind s
t (Parsed v
r s
_) = v -> s -> Result g s v
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed v
r s
t
            rewind s
_ r :: Result g s v
r@NoParse{} = Result g s v
r

instance (Show s, Textual.TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = (s -> Result g s Char) -> Parser g s Char
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s Char
p
      where p :: s -> Result g s Char
p s
rest =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
               of Just (Char
first, s
suffix) | Char -> Bool
predicate Char
first -> Char -> s -> Result g s Char
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed Char
first s
suffix
                  Maybe (Char, s)
_ -> ParseFailure Pos s -> Result g s Char
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"Char.satisfy")
   string :: String -> Parser g s String
string String
s = (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character") (s -> String) -> Parser g s s -> Parser g s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   text :: Text -> Parser g s Text
text Text
t = (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> String) -> s -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (String -> s -> String
forall a. HasCallStack => String -> a
error String
"unexpected non-character")) (s -> Text) -> Parser g s s -> Parser g s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance (Cancellative.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 -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
forall s (g :: (* -> *) -> *). s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
rest s
rest
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
forall m (g :: (* -> *) -> *).
FactorialMonoid m =>
m -> Result g m m
p
      where p :: m -> Result g m m
p m
rest = case m -> Maybe (m, m)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
rest
                     of Just (m
first, m
suffix) -> m -> m -> Result g m m
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed m
first m
suffix
                        Maybe (m, m)
_ -> ParseFailure Pos m -> Result g m m
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos m
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest) String
"anyToken")
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest =
               case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
rest
               of Just (s
first, s
suffix) | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
first s
suffix
                  Maybe (s, s)
_ -> ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"satisfy")
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = (s -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s ()
p
      where p :: s -> Result g s ()
p s
s = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                  of Just (s
first, s
_) 
                        | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfy")
                     Maybe (s, s)
_ -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
   scan :: state
-> (state -> ParserInput (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan state
s0 state -> ParserInput (Parser g s) -> Maybe state
f = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (state -> s -> Result g s s
p state
s0)
      where p :: state -> s -> Result g s s
p state
s s
rest = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
               where (s
prefix, s
suffix, state
_) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (Parser g s) -> Maybe state
f s
rest
   take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest
              | (s
prefix, s
suffix) <- Int -> s -> (s, s)
forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n s
rest, s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
              | Bool
otherwise = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) (String -> ParseFailure Pos s) -> String -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
   takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest | (s
prefix, s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
rest = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
   takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest | (s
prefix, s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
rest =
                        if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
                        then ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"takeWhile1")
                        else s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p where
      p :: s -> Result g s s
p s
s' | Just s
suffix <- s -> s -> Maybe s
forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix s
ParserInput (Parser g s)
s s
s' = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
ParserInput (Parser g s)
s s
suffix
           | Bool
otherwise = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') [s -> FailureDescription s
forall s. s -> FailureDescription s
LiteralDescription s
ParserInput (Parser g s)
s] [])
   {-# INLINABLE string #-}

instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where
   traceInput :: (ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser s -> Result g s a
p) = (s -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s a
q
      where q :: s -> Result g s a
q s
s = case String -> Result g s a -> Result g s a
traceWith String
"Parsing " (s -> Result g s a
p s
s)
                  of r :: Result g s a
r@Parsed{} -> String -> Result g s a -> Result g s a
traceWith String
"Parsed " 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
               where traceWith :: String -> Result g s a -> Result g s a
traceWith String
prefix = String -> Result g s a -> Result g s a
forall a. String -> a -> a
trace (String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
ParserInput (Parser g s)
s)

instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
               of Just (Char
first, s
suffix) | Char -> Bool
predicate Char
first -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
rest) s
suffix
                  Maybe (Char, s)
_ -> ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"satisfyCharInput")
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = (s -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s ()
p
      where p :: s -> Result g s ()
p s
s = case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
                  of Just Char
first | Char -> Bool
predicate Char
first 
                                  -> ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfyChar")
                     Maybe Char
_ -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
   scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (state -> s -> Result g s s
p state
s0)
      where p :: state -> s -> Result g s s
p state
s s
rest = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
               where (s
prefix, s
suffix, state
_) = state -> (state -> Char -> Maybe state) -> s -> (s, s, state)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
rest
   takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest | (s
prefix, s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
rest = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = (s -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s s
p
      where p :: s -> Result g s s
p s
rest | (s
prefix, s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
rest =
                     if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
                     then ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) String
"takeCharsWhile1")
                     else s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix

-- | Backtracking PEG parser
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Backtrack.'Parser' g s) -> s -> g ('ParseResults' s)
-- @
instance (Cancellative.LeftReductive s, Factorial.FactorialMonoid s) => MultiParsing (Parser g s) where
   type ResultFunctor (Parser g s) = ParseResults s
   {-# NOINLINE parsePrefix #-}
   -- | Returns an input prefix parse paired with the remaining input suffix.
   parsePrefix :: g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = (forall a. Parser g s a -> Compose (ParseResults s) ((,) s) a)
-> g (Parser 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 Pos s) (s, a)
-> Compose (Either (ParseFailure Pos s)) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) (s, a)
 -> Compose (Either (ParseFailure Pos s)) ((,) s) a)
-> (Parser g s a -> Either (ParseFailure Pos s) (s, a))
-> Parser g s a
-> Compose (Either (ParseFailure Pos s)) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result g s a -> Either (ParseFailure Pos s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult (Result g s a -> Either (ParseFailure Pos s) (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either (ParseFailure Pos s) (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
`applyParser` s
input)) g (Parser g s)
g
   parseComplete :: g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = (forall a. Parser g s a -> ParseResults s a)
-> g (Parser 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 Pos s) (s, a)
-> Either (ParseFailure Pos s) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either (ParseFailure Pos s) (s, a)
 -> Either (ParseFailure Pos s) a)
-> (Parser g s a -> Either (ParseFailure Pos s) (s, a))
-> Parser g s a
-> Either (ParseFailure Pos s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result g s a -> Either (ParseFailure Pos s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult (Result g s a -> Either (ParseFailure Pos s) (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either (ParseFailure Pos s) (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser g s a -> s -> Result g s a
forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
`applyParser` s
input))
                                      ((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)

fromResult :: (Eq s, FactorialMonoid s) => Result g s r -> ParseResults s (s, r)
fromResult :: Result g s r -> ParseResults s (s, r)
fromResult (NoParse ParseFailure Pos s
failure) = ParseFailure Pos s -> ParseResults s (s, r)
forall a b. a -> Either a b
Left ParseFailure Pos s
failure
fromResult (Parsed r
prefix s
suffix) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
suffix, r
prefix)