{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.PEG.Packrat (Parser(..), Result(..)) 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.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Factorial(FactorialMonoid)
import Data.Monoid.Textual(TextualMonoid)
import Data.Ord (Down(Down))
import Data.Semigroup (Semigroup(..))
import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf))
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 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(..),
GrammarParsing(..), MultiParsing(..),
TailsParsing(parseTails), ParseResults, ParseFailure(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (expected, TraceableParsing(..))
data Result g s v = Parsed{Result g s v -> v
parsedPrefix :: !v,
Result g s v -> [(s, g (Result g s))]
parsedSuffix :: ![(s, g (Result g s))]}
| NoParse (ParseFailure Pos s)
newtype Parser g s r = Parser{Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser :: [(s, g (Result g s))] -> Result g s r}
instance Show s => Show1 (Result g s) where
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Result g s a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecSub [a] -> ShowS
_showList Int
prec Parsed{parsedPrefix :: forall (g :: (* -> *) -> *) s v. Result g s v -> v
parsedPrefix= a
r} String
rest = String
"Parsed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> a -> ShowS
showsPrecSub Int
prec a
r String
rest
liftShowsPrec Int -> a -> ShowS
_showsPrec [a] -> ShowS
_showList Int
_prec (NoParse ParseFailure Pos s
f) String
rest = String
"NoParse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseFailure Pos s -> ShowS
forall a. Show a => a -> ShowS
shows ParseFailure Pos s
f String
rest
instance Functor (Result g s) where
fmap :: (a -> b) -> Result g s a -> Result g s b
fmap a -> b
f (Parsed a
a [(s, g (Result g s))]
rest) = b -> [(s, g (Result g s))] -> Result g s b
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (a -> b
f a
a) [(s, g (Result g s))]
rest
fmap a -> b
_ (NoParse ParseFailure Pos s
failure) = ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
instance Filterable (Result g s) where
mapMaybe :: (a -> Maybe b) -> Result g s a -> Result g s b
mapMaybe a -> Maybe b
f (Parsed a
a [(s, g (Result g s))]
rest) =
Result g s b -> (b -> Result g s b) -> Maybe b -> Result g s b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s b)
-> ParseFailure Pos s -> Result g s b
forall a b. (a -> b) -> a -> b
$ Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall m. Factorial m => m -> Int
Factorial.length [(s, g (Result g s))]
rest) String
"filter") (b -> [(s, g (Result g s))] -> Result g s b
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
`Parsed` [(s, g (Result g s))]
rest) (a -> Maybe b
f a
a)
mapMaybe a -> Maybe b
_ (NoParse ParseFailure Pos s
failure) = ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
instance Functor (Parser g s) where
fmap :: (a -> b) -> Parser g s a -> Parser g s b
fmap a -> b
f (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g 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, g (Result g s))] -> Result g s a)
-> [(s, g (Result g s))]
-> Result g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (Result g s))] -> Result g s a
p)
instance Applicative (Parser g s) where
pure :: a -> Parser g s a
pure a
a = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (a -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed a
a)
Parser [(s, g (Result g s))] -> Result g s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser [(s, g (Result g s))] -> Result g s a
q = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s b
r where
r :: [(s, g (Result g s))] -> Result g s b
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s (a -> b)
p [(s, g (Result g s))]
rest
of Parsed a -> b
f [(s, g (Result g s))]
rest' -> a -> b
f (a -> b) -> Result g s a -> Result g s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest'
NoParse ParseFailure Pos s
failure -> ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
instance Alternative (Parser g s) where
empty :: Parser g s a
empty = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
rest-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) [] [])
Parser [(s, g (Result g s))] -> Result g s a
p <|> :: Parser g s a -> Parser g s a -> Parser g s a
<|> Parser [(s, g (Result g s))] -> Result g s a
q = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
r where
r :: [(s, g (Result g s))] -> Result g s a
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
of x :: Result g s a
x@Parsed{} -> Result g s a
x
NoParse{} -> [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest
instance Filterable (Parser g s) where
mapMaybe :: (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g 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, g (Result g s))] -> Result g s a)
-> [(s, g (Result g s))]
-> Result g s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, g (Result g 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, g (Result g 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, g (Result g s))] -> Result g s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s b
r where
r :: [(s, g (Result g s))] -> Result g s b
r [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
of Parsed a
a [(s, g (Result g s))]
rest' -> Parser g s b -> [(s, g (Result g s))] -> Result g s b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser (a -> Parser g s b
f a
a) [(s, g (Result g s))]
rest'
NoParse ParseFailure Pos s
failure -> ParseFailure Pos s -> Result g s b
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
#if MIN_VERSION_base(4,13,0)
instance MonadFail (Parser g s) where
#endif
fail :: String -> Parser g s a
fail String
msg = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
rest-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])
instance MonadPlus (Parser g s) where
mzero :: Parser g s a
mzero = Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Parser g s a -> Parser g s a -> Parser g s a
mplus = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance Semigroup x => Semigroup (Parser g s x) where
<> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid x => Monoid (Parser g s x) where
mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = Parser g s x -> Parser g s x -> Parser g s x
forall a. Semigroup a => a -> a -> a
(<>)
instance FactorialMonoid s => Parsing (Parser g s) where
try :: Parser g s a -> Parser g s a
try (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = Result g s a -> Result g s a
rewindFailure ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
where rewindFailure :: Result g s a -> Result g s a
rewindFailure NoParse{} = ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) [] [])
rewindFailure Result g s a
parsed = Result g s a
parsed
Parser [(s, g (Result g s))] -> Result g s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = Result g s a -> Result g s a
replaceFailure ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
where replaceFailure :: Result g s a -> Result g s a
replaceFailure (NoParse (ParseFailure Pos
pos [FailureDescription s]
msgs [FailureDescription s]
erroneous)) =
ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos
(if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Pos
forall a. a -> Down a
Down ([(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) then [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg] else [FailureDescription s]
msgs)
[FailureDescription s]
erroneous)
replaceFailure Result g s a
parsed = Result g s a
parsed
eof :: Parser g s ()
eof = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
forall s (g :: (* -> *) -> *).
MonoidNull s =>
[(s, g (Result g s))] -> Result g s ()
p
where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
s) = ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
"end of input"] [])
p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
unexpected :: String -> Parser g s a
unexpected String
msg = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
t-> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (ParseFailure Pos s -> Result g s a)
-> ParseFailure Pos s -> Result g s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
t) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])
notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> [(s, g (Result g s))] -> Result g s a -> Result g s ()
forall s (g :: (* -> *) -> *) (g :: (* -> *) -> *) s v.
[(s, g (Result g s))] -> Result g s v -> Result g s ()
rewind [(s, g (Result g s))]
input ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
input))
where rewind :: [(s, g (Result g s))] -> Result g s v -> Result g s ()
rewind [(s, g (Result g s))]
t Parsed{} = ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
t) [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
"notFollowedBy"] [])
rewind [(s, g (Result g s))]
t NoParse{} = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
t
instance FactorialMonoid s => CommittedParsing (Parser g s) where
type CommittedResults (Parser g s) = ParseResults s
commit :: Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))]
-> Result g s (Either (ParseFailure Pos s) a))
-> Parser g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s (Either (ParseFailure Pos s) a)
q
where q :: [(s, g (Result g s))] -> Result g s (Either (ParseFailure Pos s) a)
q [(s, g (Result g s))]
rest = case [(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest
of NoParse ParseFailure Pos s
failure -> Either (ParseFailure Pos s) a
-> [(s, g (Result g s))]
-> Result g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (ParseFailure Pos s -> Either (ParseFailure Pos s) a
forall a b. a -> Either a b
Left ParseFailure Pos s
failure) [(s, g (Result g s))]
rest
Parsed a
a [(s, g (Result g s))]
rest' -> Either (ParseFailure Pos s) a
-> [(s, g (Result g s))]
-> Result g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (a -> Either (ParseFailure Pos s) a
forall a b. b -> Either a b
Right a
a) [(s, g (Result g s))]
rest'
admit :: Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser [(s, g (Result g s))]
-> Result g s (CommittedResults (Parser g s) a)
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = case [(s, g (Result g s))]
-> Result g s (CommittedResults (Parser g s) a)
p [(s, g (Result g s))]
rest
of NoParse ParseFailure Pos s
failure -> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
Parsed (Left failure) [(s, g (Result g s))]
_ -> ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse ParseFailure Pos s
failure
Parsed (Right a) [(s, g (Result g s))]
rest' -> a -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed a
a [(s, g (Result g s))]
rest'
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
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, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (\[(s, g (Result g s))]
input-> [(s, g (Result g s))] -> Result g s a -> Result g s a
forall s (g :: (* -> *) -> *) v.
[(s, g (Result g s))] -> Result g s v -> Result g s v
rewind [(s, g (Result g s))]
input ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
input))
where rewind :: [(s, g (Result g s))] -> Result g s v -> Result g s v
rewind [(s, g (Result g s))]
t (Parsed v
r [(s, g (Result g s))]
_) = v -> [(s, g (Result g s))] -> Result g s v
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed v
r [(s, g (Result g s))]
t
rewind [(s, g (Result g 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, g (Result g s))] -> Result g s Char) -> Parser g s Char
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s Char
p
where p :: [(s, g (Result g s))] -> Result g s Char
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) =
case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first -> Char -> [(s, g (Result g s))] -> Result g s Char
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed Char
first [(s, g (Result g s))]
t
Maybe Char
_ -> ParseFailure Pos s -> Result g s Char
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"Char.satisfy")
p [] = ParseFailure Pos s -> Result g s Char
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 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 (Eq s, LeftReductive s, FactorialMonoid s) => GrammarParsing (Parser g s) where
type ParserGrammar (Parser g s) = g
type GrammarFunctor (Parser g s) = Result g s
parsingResult :: ParserInput (Parser g s)
-> GrammarFunctor (Parser g s) a
-> ResultFunctor (Parser g s) (ParserInput (Parser g s), a)
parsingResult = (Result g s a -> ParseResults s (s, a))
-> s -> Result g s a -> ParseResults s (s, a)
forall a b. a -> b -> a
const Result g s a -> ParseResults s (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult
nonTerminal :: (g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a)
-> Parser g s a
nonTerminal g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
p where
p :: [(s, g (Result g s))] -> Result g s a
p ((s
_, g (Result g s)
d) : [(s, g (Result g s))]
_) = g (GrammarFunctor (Parser g s)) -> GrammarFunctor (Parser g s) a
f g (Result g s)
g (GrammarFunctor (Parser g s))
d
p [(s, g (Result g s))]
_ = ParseFailure Pos s -> Result g s a
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"NonTerminal at endOfInput")
instance (Eq s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where
parseTails :: Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
parseTails = Parser g s r
-> [(ParserInput (Parser g s), g (GrammarFunctor (Parser g s)))]
-> GrammarFunctor (Parser g s) r
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser
instance (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, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
forall s (g :: (* -> *) -> *).
Monoid s =>
[(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
s [(s, g (Result g s))]
rest
p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
forall s (g :: (* -> *) -> *).
FactorialMonoid s =>
[(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
of Just (s
first, s
_) -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
first [(s, g (Result g s))]
t
Maybe (s, s)
_ -> ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"anyToken")
p [] = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"anyToken")
satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) =
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 -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
first [(s, g (Result g s))]
t
Maybe (s, s)
_ -> ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"satisfy")
p [] = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"satisfy")
notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
p
where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)
| Just (s
first, s
_) <- s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s,
ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first = ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"notSatisfy")
p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
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, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (state -> [(s, g (Result g s))] -> Result g s s
p state
s0)
where p :: state -> [(s, g (Result g s))] -> Result g s s
p state
s ((s
i, g (Result g s)
_):[(s, g (Result g s))]
t) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
where (s
prefix, s
_, 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
i
p state
_ [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
x <- Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
n s
s, s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop Int
n [(s, g (Result g s))]
rest)
p [] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
p [(s, g (Result g s))]
rest = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) (String -> ParseFailure Pos s) -> String -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
x <- (s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.takeWhile s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s, Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
x) =
s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
p [(s, g (Result g s))]
rest = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"takeWhile1")
string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p where
p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s', g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
ParserInput (Parser g s)
s s -> s -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` s
s' = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
ParserInput (Parser g s)
s (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
ParserInput (Parser g s)
s) [(s, g (Result g s))]
rest)
p [(s, g (Result g s))]
rest = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) [s -> FailureDescription s
forall s. s -> FailureDescription s
LiteralDescription s
ParserInput (Parser g s)
s] [])
instance (InputParsing (Parser g s), Monoid s) => TraceableParsing (Parser g s) where
traceInput :: (ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser [(s, g (Result g s))] -> Result g s a
p) = ([(s, g (Result g s))] -> Result g s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s a
q
where q :: [(s, g (Result g s))] -> Result g s a
q [(s, g (Result g s))]
rest = case String -> Result g s a -> Result g s a
traceWith String
"Parsing " ([(s, g (Result g s))] -> Result g s a
p [(s, g (Result g s))]
rest)
of r :: Result g s a
r@Parsed{} -> String -> Result g s a -> Result g s a
traceWith String
"Parsed " Result g s a
r
r :: Result g s a
r@NoParse{} -> String -> Result g s a -> Result g s a
traceWith String
"Failed " Result g s a
r
where traceWith :: String -> Result g s a -> Result g s a
traceWith String
prefix = String -> Result g s a -> Result g s a
forall a. String -> a -> a
trace (String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description (case [(s, g (Result g s))]
rest
of ((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) -> s
ParserInput (Parser g s)
s
[] -> ParserInput (Parser g s)
forall a. Monoid a => a
mempty))
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, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
t) =
case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first -> s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed (s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) [(s, g (Result g s))]
t
Maybe Char
_ -> ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"satisfyCharInput")
p [] = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected Pos
0 String
"satisfyCharInput")
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s ()
p
where p :: [(s, g (Result g s))] -> Result g s ()
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)
| Just Char
first <- s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s,
Char -> Bool
predicate Char
first = ParseFailure Pos s -> Result g s ()
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"notSatisfyChar")
p [(s, g (Result g s))]
rest = () -> [(s, g (Result g s))] -> Result g s ()
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed () [(s, g (Result g s))]
rest
scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser (state -> [(s, g (Result g s))] -> Result g s s
p state
s0)
where p :: state -> [(s, g (Result g s))] -> Result g s s
p state
s ((s
i, g (Result g s)
_):[(s, g (Result g s))]
t) = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
prefix (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(s, g (Result g s))]
t)
where (s
prefix, s
_, 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
i
p state
_ [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s =
s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
p [] = s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
forall a. Monoid a => a
mempty []
takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = ([(s, g (Result g s))] -> Result g s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
([(s, g (Result g s))] -> Result g s r) -> Parser g s r
Parser [(s, g (Result g s))] -> Result g s s
p
where p :: [(s, g (Result g s))] -> Result g s s
p rest :: [(s, g (Result g s))]
rest@((s
s, g (Result g s)
_) : [(s, g (Result g s))]
_)
| s
x <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
predicate s
s, Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
x) =
s -> [(s, g (Result g s))] -> Result g s s
forall (g :: (* -> *) -> *) s v.
v -> [(s, g (Result g s))] -> Result g s v
Parsed s
x (Int -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. Int -> [a] -> [a]
drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
x) [(s, g (Result g s))]
rest)
p [(s, g (Result g s))]
rest = ParseFailure Pos s -> Result g s s
forall (g :: (* -> *) -> *) s v. ParseFailure Pos s -> Result g s v
NoParse (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
forall a. a -> Down a
Down (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(s, g (Result g s))]
rest) String
"takeCharsWhile1")
instance (LeftReductive s, FactorialMonoid s) => MultiParsing (Parser g s) where
type ResultFunctor (Parser g s) = ParseResults s
type GrammarConstraint (Parser g s) g' = (g ~ g', Rank2.Functor g)
{-# 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. Result g s a -> Compose (ParseResults s) ((,) s) a)
-> g (Result g s) -> g (Compose (ParseResults s) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Either (ParseFailure Pos s) (s, a)
-> Compose (ParseResults s) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) (s, a)
-> Compose (ParseResults s) ((,) s) a)
-> (Result g s a -> Either (ParseFailure Pos s) (s, a))
-> Result g s a
-> Compose (ParseResults s) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result g s a -> Either (ParseFailure Pos s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult) ((s, g (Result g s)) -> g (Result g s)
forall a b. (a, b) -> b
snd ((s, g (Result g s)) -> g (Result g s))
-> (s, g (Result g s)) -> g (Result g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> (s, g (Result g s))
forall a. [a] -> a
head ([(s, g (Result g s))] -> (s, g (Result g s)))
-> [(s, g (Result g s))] -> (s, g (Result g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
parseComplete :: g (Parser g s) -> s -> g (ResultFunctor (Parser g s))
parseComplete g (Parser g s)
g s
input = (forall a. Result g s a -> ParseResults s a)
-> g (Result g s) -> g (ParseResults s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Either (ParseFailure Pos s) (s, a)
-> Either (ParseFailure Pos s) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either (ParseFailure Pos s) (s, a)
-> Either (ParseFailure Pos s) a)
-> (Result g s a -> Either (ParseFailure Pos s) (s, a))
-> Result g s a
-> Either (ParseFailure Pos s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result g s a -> Either (ParseFailure Pos s) (s, a)
forall s (g :: (* -> *) -> *) r.
(Eq s, Monoid s) =>
Result g s r -> ParseResults s (s, r)
fromResult)
((s, g (Result g s)) -> g (Result g s)
forall a b. (a, b) -> b
snd ((s, g (Result g s)) -> g (Result g s))
-> (s, g (Result g s)) -> g (Result g s)
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))] -> (s, g (Result g s))
forall a. [a] -> a
head ([(s, g (Result g s))] -> (s, g (Result g s)))
-> [(s, g (Result g s))] -> (s, g (Result g s))
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
Functor g =>
g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails g (Parser g s)
close ([(s, g (Result g s))] -> [(s, g (Result g s))])
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a b. (a -> b) -> a -> b
$ g (Parser g s) -> s -> [(s, g (Result g s))]
forall (g :: (* -> *) -> *) s.
(Functor g, FactorialMonoid s) =>
g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g (Parser g s)
g s
s
input)
where close :: g (Parser g s)
close = (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
parseGrammarTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails :: g (Parser g s) -> s -> [(s, g (Result g s))]
parseGrammarTails g (Parser g s)
g s
input = (s -> [(s, g (Result g s))] -> [(s, g (Result g s))])
-> [(s, g (Result g s))] -> [s] -> [(s, g (Result g s))]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [(s, g (Result g s))] -> [(s, g (Result g s))]
parseTail [] (s -> [s]
forall m. FactorialMonoid m => m -> [m]
Factorial.tails s
input)
where parseTail :: s -> [(s, g (Result g s))] -> [(s, g (Result g s))]
parseTail s
s [(s, g (Result g s))]
parsedTail = [(s, g (Result g s))]
parsed where
parsed :: [(s, g (Result g s))]
parsed = (s
s,g (Result g s)
d)(s, g (Result g s))
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsedTail
d :: g (Result g s)
d = (forall a. Parser g s a -> Result g s a)
-> g (Parser g s) -> g (Result 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 ((([(s, g (Result g s))] -> Result g s a)
-> [(s, g (Result g s))] -> Result g s a
forall a b. (a -> b) -> a -> b
$ [(s, g (Result g s))]
parsed) (([(s, g (Result g s))] -> Result g s a) -> Result g s a)
-> (Parser g s a -> [(s, g (Result g s))] -> Result g s a)
-> Parser g s a
-> Result g s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser g s a -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
applyParser) g (Parser g s)
g
reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails :: g (Parser g s) -> [(s, g (Result g s))] -> [(s, g (Result g s))]
reparseTails g (Parser g s)
_ [] = []
reparseTails g (Parser g s)
final parsed :: [(s, g (Result g s))]
parsed@((s
s, g (Result g s)
_):[(s, g (Result g s))]
_) = (s
s, g (Result g s)
gd)(s, g (Result g s))
-> [(s, g (Result g s))] -> [(s, g (Result g s))]
forall a. a -> [a] -> [a]
:[(s, g (Result g s))]
parsed
where gd :: g (Result g s)
gd = (forall a. Parser g s a -> Result g s a)
-> g (Parser g s) -> g (Result 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 -> [(s, g (Result g s))] -> Result g s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> [(s, g (Result g s))] -> Result g s r
`applyParser` [(s, g (Result g s))]
parsed) g (Parser g s)
final
fromResult :: (Eq s, Monoid s) => Result g s r -> ParseResults s (s, r)
fromResult :: Result g s r -> ParseResults s (s, r)
fromResult (NoParse (ParseFailure Pos
pos [FailureDescription s]
positive [FailureDescription s]
negative)) = ParseFailure Pos s -> ParseResults s (s, r)
forall a b. a -> Either a b
Left (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
- Pos
1) [FailureDescription s]
positive [FailureDescription s]
negative)
fromResult (Parsed r
prefix []) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
forall a. Monoid a => a
mempty, r
prefix)
fromResult (Parsed r
prefix ((s
s, g (Result g s)
_):[(s, g (Result g s))]
_)) = (s, r) -> ParseResults s (s, r)
forall a b. b -> Either a b
Right (s
s, r
prefix)