{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
module Text.Grampa.PEG.Backtrack.Measured (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 -> Int
parsedLength :: !Int,
Result g s v -> v
parsedResult :: !v,
Result g s v -> s
parsedSuffix :: !s}
| NoParse FailureInfo
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{parsedResult :: forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedResult= 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 l :: Int
l a :: a
a rest :: 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 _ (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 (Int -> a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 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 l :: Int
l f :: a -> b
f rest' :: s
rest' -> case s -> Result g s a
q s
rest'
of Parsed l' :: Int
l' a :: a
a rest'' :: 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 failure :: FailureInfo
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
failure
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
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 l :: Int
l a :: a
a rest' :: 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 l' :: Int
l' b :: b
b rest'' :: 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 failure :: FailureInfo
failure -> FailureInfo -> Result g s b
forall (g :: (* -> *) -> *) s v. FailureInfo -> Result g s v
NoParse FailureInfo
failure
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{} = Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 () 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 _) = Int -> v -> s -> Result g s v
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 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 = Int -> () -> m -> Result g m ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 () 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 = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 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) -> Int -> m -> m -> Result g m m
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 1 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 -> Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 1 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 -> Int -> Char -> s -> Result g s Char
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 1 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 -> Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 1 (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"])
_ -> Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 () 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"])
_ -> Int -> () -> s -> Result g s ()
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 () 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 = Int -> t -> t -> Result g t t
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix) 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 = Int -> t -> t -> Result g t t
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed (t -> Int
forall m. Factorial m => m -> Int
Factorial.length t
prefix) 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 =
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 :: (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 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
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 =
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 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 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 :: 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' = Int -> s -> s -> Result g s s
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed Int
l 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])
l :: Int
l = s -> Int
forall m. Factorial m => m -> Int
Factorial.length 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 l :: Int
l prefix :: a
prefix suffix :: s
suffix -> let Parsed l' :: Int
l' prefix' :: a
prefix' suffix' :: s
suffix' = s -> Result g s a
q s
suffix
in Int -> a -> s -> Result g s a
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 -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
prefix a
prefix') s
suffix'
NoParse{} -> Int -> a -> s -> Result g s a
forall (g :: (* -> *) -> *) s v. Int -> v -> s -> Result g s v
Parsed 0 a
forall a. Monoid a => a
mempty s
rest
{-# INLINABLE string #-}
instance MultiParsing Parser where
type ResultFunctor Parser = ParseResults
{-# NOINLINE parsePrefix #-}
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)