{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, UndecidableInstances #-}
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 (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))
data Result (g :: (Type -> Type) -> Type) s v =
Parsed{forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedPrefix :: !v,
forall (g :: (* -> *) -> *) s v. Result g s v -> s
parsedSuffix :: !s}
| NoParse (ParseFailure Pos s)
newtype Parser g s r = Parser{forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
applyParser :: 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
rest) = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (a -> b
f a
a) 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 Factorial.FactorialMonoid s => 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
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
rest) String
"filter") (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 (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 -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
(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 -> Result g s a
p)
{-# INLINABLE fmap #-}
instance Applicative (Parser g s) where
pure :: forall a. a -> Parser g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed a
a)
Parser 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 -> Result g s a
q = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Result g s a
q 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
{-# INLINABLE (<*>) #-}
instance Factorial.FactorialMonoid s => Alternative (Parser g s) where
empty :: forall a. Parser g s a
empty = forall (g :: (* -> *) -> *) s r.
(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
. Int -> Down Int
fromEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Factorial m => m -> Int
Factorial.length)
<|> :: forall 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
alt :: Parser g s a -> Parser g s a -> Parser g s a
Parser s -> Result g s a
p alt :: forall (g :: (* -> *) -> *) s a.
Parser g s a -> Parser g s a -> Parser g s a
`alt` Parser s -> Result g s a
q = 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 :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser s -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
(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 -> 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 -> 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 -> 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' -> 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 (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 Factorial.FactorialMonoid s => MonadFail (Parser g s) where
fail :: forall a. String -> Parser g s a
fail String
msg = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\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 (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
rest) String
msg)
#endif
instance Factorial.FactorialMonoid s => 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 Factorial.FactorialMonoid s => Parsing (Parser g s) where
try :: forall a. Parser g s a -> Parser g s a
try (Parser s -> Result g s a
p) = 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{} = 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 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 <?> :: forall a. Parser g s a -> String -> Parser g s a
<?> String
msg = 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 (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
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 -> Result g s r) -> Parser g s r
Parser forall {m} {g :: (* -> *) -> *}.
(MonoidNull m, Factorial m) =>
m -> Result g m ()
p
where p :: m -> Result g m ()
p m
rest
| forall m. MonoidNull m => m -> Bool
Null.null m
rest = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () m
rest
| Bool
otherwise = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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 m
rest) String
"end of input")
unexpected :: forall a. String -> Parser g s a
unexpected String
msg = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\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 (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
t) String
msg)
notFollowedBy :: forall a. Show a => Parser g s a -> Parser g s ()
notFollowedBy (Parser s -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
input-> 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{} = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
t) String
"notFollowedBy")
rewind s
t NoParse{} = 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 :: forall a.
Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser s -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s (Either (ParseFailure (Down Int) s) a)
q
where q :: s -> Result g s (Either (ParseFailure (Down Int) s) a)
q s
rest = case s -> Result g s a
p s
rest
of NoParse ParseFailure (Down Int) s
failure -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure) s
rest
Parsed a
a s
rest' -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (forall a b. b -> Either a b
Right a
a) s
rest'
admit :: forall a.
Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser s -> Result g s (CommittedResults (Parser g s) a)
p) = 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 (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
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse ParseFailure (Down Int) s
failure
Parsed (Right a
a) s
rest' -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed a
a s
rest'
instance FactorialMonoid s => DeterministicParsing (Parser g s) where
<<|> :: forall 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 :: 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 Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where
lookAhead :: forall a. Parser g s a -> Parser g s a
lookAhead (Parser s -> Result g s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser (\s
input-> 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
_) = 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 = 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 forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
of Just (Char
first, s
suffix) | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed Char
first s
suffix
Maybe (Char, s)
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
rest) 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)
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 = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser forall {s} {g :: (* -> *) -> *}. s -> Result g s s
p
where p :: s -> Result g s s
p s
rest = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
rest s
rest
anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser forall {m} {g :: (* -> *) -> *}.
FactorialMonoid m =>
m -> Result g m m
p
where p :: m -> Result g m m
p m
rest = case forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
rest
of Just (m
first, m
suffix) -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed m
first m
suffix
Maybe (m, m)
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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 m
rest) 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 -> 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 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
first -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
first s
suffix
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 (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ 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 = 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 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.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
s) String
"notSatisfy")
Maybe (s, s)
_ -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
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 -> 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 = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
where (s
prefix, s
suffix, 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
rest
take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = 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) <- forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n s
rest, forall m. Factorial m => m -> Int
Factorial.length s
prefix forall a. Eq a => a -> a -> Bool
== Int
n = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
| Bool
otherwise = forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
rest) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ 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 = 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) <- forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span ParserInput (Parser g s) -> Bool
predicate s
rest = 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 = 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) <- forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span ParserInput (Parser g s) -> Bool
predicate s
rest =
if forall m. MonoidNull m => m -> Bool
Null.null s
prefix
then forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
rest) String
"takeWhile1")
else 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 = 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 <- forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix ParserInput (Parser g s)
s s
s' = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed ParserInput (Parser g s)
s s
suffix
| Bool
otherwise = 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 m. Factorial m => m -> Int
Factorial.length s
s') ParserInput (Parser g s)
s)
{-# INLINABLE string #-}
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 -> Result g s a
p) = 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{}
| let prefix :: s
prefix = forall m. FactorialMonoid m => Int -> m -> m
Factorial.take (forall m. Factorial m => m -> Int
Factorial.length s
s forall a. Num a => a -> a -> a
- forall m. Factorial m => m -> Int
Factorial.length (forall (g :: (* -> *) -> *) s v. Result g s v -> s
parsedSuffix Result g s a
r)) s
s
-> 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
where 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
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 = 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 forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
rest
of Just (Char
first, s
suffix) | Char -> Bool
predicate Char
first -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed (forall m. Factorial m => m -> m
Factorial.primePrefix s
rest) s
suffix
Maybe (Char, s)
_ -> forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
rest) String
"satisfyCharInput")
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = 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 forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | 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 (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfyChar")
Maybe Char
_ -> forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed () s
s
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 -> 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 = forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
where (s
prefix, s
suffix, 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 = 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) <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
rest = 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 = 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) <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
rest =
if forall m. MonoidNull m => m -> Bool
Null.null s
prefix
then forall (g :: (* -> *) -> *) s v.
ParseFailure (Down Int) s -> Result g s v
NoParse (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
rest) String
"takeCharsWhile1")
else forall (g :: (* -> *) -> *) s v. v -> s -> Result g s v
Parsed s
prefix s
suffix
instance (Cancellative.LeftReductive s, Factorial.FactorialMonoid s) => MultiParsing (Parser g s) where
type ResultFunctor (Parser g s) = ParseResults s
{-# 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, FactorialMonoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
`applyParser` s
input)) g (Parser g s)
g
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, FactorialMonoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (g :: (* -> *) -> *) s r. Parser g s r -> s -> Result g s r
`applyParser` 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 :: forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult (NoParse ParseFailure (Down Int) s
failure) = forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure
fromResult (Parsed r
prefix s
suffix) = forall a b. b -> Either a b
Right (s
suffix, r
prefix)