{-# LANGUAGE 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(..))

import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (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(..), 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
parsedSuffix :: !s}
                                     | NoParse FailureInfo

-- | 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 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
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 _ (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 -> 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
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 p :: s -> Result g s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser q :: 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 rest :: s
rest = case s -> Result g s (a -> b)
p s
rest
               of Parsed f :: a -> b
f rest' :: 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 failure :: FailureInfo
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
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 (\rest :: 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 -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["empty"])
   <|> :: 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 p :: s -> Result g s a
p alt :: Parser g s a -> Parser g s a -> Parser g s a
`alt` Parser q :: 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 rest :: 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 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 -> 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 -> 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 rest :: s
rest = case s -> Result g s a
p s
rest
               of Parsed a :: a
a rest' :: 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 failure :: FailureInfo
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
failure

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 = (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 -> 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 rest :: 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 (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 -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [])
                     rewindFailure parsed :: Result g s a
parsed = Result g s a
parsed
   Parser p :: s -> Result g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> msg :: 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 rest :: 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 (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 -> Int
forall m. Factorial m => m -> Int
Factorial.length 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 -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\t :: 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 -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String
msg])
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser p :: 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 (\input :: 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 t :: s
t Parsed{} = FailureInfo -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) ["notFollowedBy"])
            rewind t :: s
t NoParse{} = () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
t

instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser p :: 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 (\input :: 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 t :: s
t (Parsed r :: v
r _) = v -> s -> Result g s v
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed v
r 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 MonoidParsing (Parser g) where
   endOfInput :: Parser g s ()
endOfInput = (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 rest :: 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 = FailureInfo -> Result g m ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest) ["endOfInput"])
   getInput :: Parser g s 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 rest :: 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 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 rest :: m
rest = case m -> Maybe (m, m)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
rest
                     of Just (first :: m
first, suffix :: m
suffix) -> m -> m -> Result g m m
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed m
first m
suffix
                        _ -> FailureInfo -> Result g m m
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest) ["anyToken"])
   satisfy :: (s -> Bool) -> Parser g s s
satisfy predicate :: 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 rest :: s
rest =
               case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
rest
               of Just (first :: s
first, suffix :: s
suffix) | s -> Bool
predicate s
first -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
first s
suffix
                  _ -> FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["satisfy"])
   satisfyChar :: (Char -> Bool) -> Parser g s Char
satisfyChar predicate :: 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 rest :: s
rest =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
               of Just (first :: Char
first, suffix :: 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
                  _ -> FailureInfo -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["satisfyChar"])
   satisfyCharInput :: (Char -> Bool) -> Parser g s s
satisfyCharInput predicate :: 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 rest :: s
rest =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
               of Just (first :: Char
first, suffix :: 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
                  _ -> FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["satisfyChar"])
   notSatisfy :: (s -> Bool) -> Parser g s ()
notSatisfy predicate :: 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
s = 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 -> FailureInfo -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["notSatisfy"])
                     _ -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar predicate :: 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
s = 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 
                                  -> FailureInfo -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["notSatisfyChar"])
                     _ -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
   scan :: s -> (s -> t -> Maybe s) -> Parser g t t
scan s0 :: s
s0 f :: s -> t -> Maybe s
f = (t -> Result g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (s -> t -> Result g t t
p s
s0)
      where p :: s -> t -> Result g t t
p s :: s
s rest :: t
rest = t -> t -> Result g t t
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed t
prefix t
suffix
               where (prefix :: t
prefix, suffix :: t
suffix, _) = 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
rest
   scanChars :: s -> (s -> Char -> Maybe s) -> Parser g t t
scanChars s0 :: s
s0 f :: s -> Char -> Maybe s
f = (t -> Result g t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (s -> t -> Result g t t
p s
s0)
      where p :: s -> t -> Result g t t
p s :: s
s rest :: t
rest = t -> t -> Result g t t
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed t
prefix t
suffix
               where (prefix :: t
prefix, suffix :: t
suffix, _) = 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
rest
   takeWhile :: (s -> Bool) -> Parser g s s
takeWhile predicate :: 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 rest :: s
rest | (prefix :: s
prefix, suffix :: s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span 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 :: (s -> Bool) -> Parser g s s
takeWhile1 predicate :: 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 rest :: s
rest | (prefix :: s
prefix, suffix :: s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
predicate s
rest =
                        if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
                        then FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["takeWhile1"])
                        else s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
   takeCharsWhile :: (Char -> Bool) -> Parser g s s
takeCharsWhile predicate :: 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 rest :: s
rest | (prefix :: s
prefix, suffix :: 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 s
takeCharsWhile1 predicate :: 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 rest :: s
rest | (prefix :: s
prefix, suffix :: 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 FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) ["takeCharsWhile1"])
                     else s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
   string :: s -> Parser g s s
string s :: 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
s' | Just suffix :: s
suffix <- s -> s -> Maybe s
forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix s
s s
s' = s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
s s
suffix
           | Bool
otherwise = FailureInfo -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') ["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 (Parser p :: 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 rest :: s
rest = case s -> Result g s a
p s
rest
                     of Parsed prefix :: a
prefix suffix :: s
suffix -> let Parsed prefix' :: a
prefix' suffix' :: s
suffix' = s -> Result g s a
q s
suffix
                                                in a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
prefix a
prefix') s
suffix'
                        NoParse{} -> a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed a
forall a. Monoid a => a
mempty s
rest
   {-# INLINABLE string #-}

-- | Backtracking PEG parser
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Backtrack.'Parser' g s) -> s -> g 'ParseResults'
-- @
instance MultiParsing Parser where
   type ResultFunctor Parser = ParseResults
   {-# NOINLINE parsePrefix #-}
   -- | Returns an input prefix parse paired with the remaining input suffix.
   parsePrefix :: g (Parser g s) -> s -> g (Compose (ResultFunctor Parser) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a. Parser g s a -> Compose ParseResults ((,) s) a)
-> g (Parser 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)
-> (Parser g s a -> Either ParseFailure (s, a))
-> Parser 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 (Result g s a -> Either ParseFailure (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either ParseFailure (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)
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a. Parser g s a -> ParseResults a)
-> g (Parser 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)
-> (Parser g s a -> Either ParseFailure (s, a))
-> Parser 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 (Result g s a -> Either ParseFailure (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either ParseFailure (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 :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput) g (Parser g s)
g)

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 suffix :: s
suffix) = (s, r) -> ParseResults (s, r)
forall a b. b -> Either a b
Right (s
suffix, r
prefix)