{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
module Text.Grampa.PEG.Backtrack.Measured (Parser(..), Result(..), alt) where
import Control.Applicative (Applicative(..), Alternative(..), liftA2)
import Control.Monad (Monad(..), MonadFail(fail), 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 Data.Witherable.Class (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.Grampa.Class (DeterministicParsing(..), InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),
MultiParsing(..), ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (FailureInfo(..))
data Result (g :: (* -> *) -> *) s v = Parsed{Result g s v -> Int
parsedLength :: !Int,
Result g s v -> v
parsedResult :: !v,
Result g s v -> s
parsedSuffix :: !s}
| NoParse (FailureInfo s)
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{parsedResult :: forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedResult= 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 FailureInfo s
f) String
rest = String
"NoParse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo 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 Int
l a
a s
rest) = Int -> b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
l (a -> b
f a
a) s
rest
fmap a -> b
_ (NoParse FailureInfo s
failure) = FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo 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 Int
l 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 (FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s b) -> FailureInfo s -> Result g s b
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"filter"]) (\b
b-> Int -> b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
l b
b s
rest) (a -> Maybe b
f a
a)
mapMaybe a -> Maybe b
_ (NoParse FailureInfo s
failure) = FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo 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 (Int -> a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 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 Int
l a -> b
f s
rest' -> case s -> Result g s a
q s
rest'
of Parsed Int
l' a
a s
rest'' -> Int -> b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') (a -> b
f a
a) s
rest''
NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
{-# INLINABLE (<*>) #-}
instance 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-> FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s a) -> FailureInfo s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"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
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 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 Int
l a
a s
rest' -> case 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'
of Parsed Int
l' b
b s
rest'' -> Int -> b -> s -> Result g s b
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l') b
b s
rest''
NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
NoParse FailureInfo s
failure -> FailureInfo s -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
instance 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-> FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s a) -> FailureInfo s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
instance 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 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 (FailureInfo Int
_pos [Expected s]
_msgs)) =
FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (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 (FailureInfo Int
pos [Expected s]
msgs)) =
FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected s] -> FailureInfo s) -> [Expected s] -> FailureInfo s
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 -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected 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 = Int -> () -> m -> Result g m ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 () m
rest
| Bool
otherwise = FailureInfo m -> Result g m ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest) [String -> Expected m
forall s. String -> Expected s
Expected 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-> FailureInfo s -> Result g s a
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (FailureInfo s -> Result g s a) -> FailureInfo s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String -> Expected s
forall s. String -> Expected s
Expected 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{} = FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String -> Expected s
forall s. String -> Expected s
Expected String
"notFollowedBy"])
rewind s
t NoParse{} = Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 () s
t
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 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 Int
_ v
r s
_) = Int -> v -> s -> Result g s v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 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 -> Int -> Char -> s -> Result g s Char
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
1 Char
first s
suffix
Maybe (Char, s)
_ -> FailureInfo s -> Result g s Char
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected 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 = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 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) -> Int -> m -> m -> Result g m m
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
1 m
first m
suffix
Maybe (m, m)
_ -> FailureInfo m -> Result g m m
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
rest) [String -> Expected m
forall s. String -> Expected s
Expected 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 -> Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
1 s
first s
suffix
Maybe (s, s)
_ -> FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected 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 -> FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfy"])
Maybe (s, s)
_ -> Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 () 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 = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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 = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
n s
prefix s
suffix
| Bool
otherwise = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected (String -> Expected s) -> String -> Expected 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 =
Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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 FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeWhile1"])
else Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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' = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
l s
ParserInput (Parser g s)
s s
suffix
| Bool
otherwise = FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') [s -> Expected s
forall s. s -> Expected s
ExpectedInput s
ParserInput (Parser g s)
s])
l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s
{-# INLINABLE string #-}
instance (Cancellative.LeftReductive s, FactorialMonoid s) => ConsumedInputParsing (Parser g s) where
match :: Parser g s a -> Parser g s (ParserInput (Parser g s), a)
match (Parser s -> Result g s a
p) = (s -> Result g s (s, a)) -> Parser g s (s, a)
forall (g :: (* -> *) -> *) s r.
(s -> Result g s r) -> Parser g s r
Parser s -> Result g s (s, a)
q
where q :: s -> Result g s (s, a)
q s
rest = case s -> Result g s a
p s
rest
of Parsed Int
l a
prefix s
suffix -> Int -> (s, a) -> s -> Result g s (s, a)
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
l (Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
l s
rest, a
prefix) s
suffix
NoParse FailureInfo s
failure -> FailureInfo s -> Result g s (s, a)
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse FailureInfo s
failure
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 -> Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
1 (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
rest) s
suffix
Maybe (Char, s)
_ -> FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfyChar"])
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
-> FailureInfo s -> Result g s ()
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfyChar"])
Maybe Char
_ -> Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
0 () 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 = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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 =
Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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 FailureInfo s -> Result g s s
forall (g :: (* -> *) -> *) s v. FailureInfo s -> Result g s v
NoParse (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeCharsWhile1"])
else Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix) 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 :: 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 s) (s, a)
-> Compose (Either (ParseFailure s)) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) (s, a)
-> Compose (Either (ParseFailure s)) ((,) s) a)
-> (Parser g s a -> Either (ParseFailure s) (s, a))
-> Parser g s a
-> Compose (Either (ParseFailure s)) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either (ParseFailure s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> Result g s r -> ParseResults s (s, r)
fromResult s
input (Result g s a -> Either (ParseFailure s) (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either (ParseFailure 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 s) (s, a) -> Either (ParseFailure s) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either (ParseFailure s) (s, a) -> Either (ParseFailure s) a)
-> (Parser g s a -> Either (ParseFailure s) (s, a))
-> Parser g s a
-> Either (ParseFailure s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Result g s a -> Either (ParseFailure s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, FactorialMonoid s) =>
s -> Result g s r -> ParseResults s (s, r)
fromResult s
input (Result g s a -> Either (ParseFailure s) (s, a))
-> (Parser g s a -> Result g s a)
-> Parser g s a
-> Either (ParseFailure 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) => s -> Result g s r -> ParseResults s (s, r)
fromResult :: s -> Result g s r -> ParseResults s (s, r)
fromResult s
s (NoParse (FailureInfo Int
pos [Expected s]
msgs)) =
ParseFailure s -> ParseResults s (s, r)
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
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
+ Int
1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResult s
_ (Parsed Int
_ r
prefix s
suffix) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
suffix, r
prefix)