{-# LANGUAGE CPP, FlexibleContexts, InstanceSigs, GeneralizedNewtypeDeriving,
RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.Parallel (ResultList(..), Parser)
where
import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
#if MIN_VERSION_base(4,13,0)
import Control.Monad (MonadFail(fail))
#endif
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.Kind (Type)
import Data.List (intercalate)
import Data.Semigroup (Semigroup(..))
import qualified Data.Semigroup.Cancellative as Cancellative
import Data.Monoid (Monoid(mappend, mempty))
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Null as Null
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.String (fromString)
import Debug.Trace (trace)
import Witherable (Filterable(mapMaybe))
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 qualified Rank2
import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),
InputParsing(..), InputCharParsing(..), MultiParsing(..),
ParseResults, ParseFailure(..), Pos)
import Text.Grampa.Internal (BinTree(..), emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure,
TraceableParsing(..))
import Prelude hiding (iterate, null, showList, span, takeWhile)
newtype Parser (g :: (Type -> Type) -> Type) s r = Parser{forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
applyParser :: s -> ResultList s r}
data ResultList s r = ResultList !(BinTree (ResultInfo s r)) (ParseFailure Pos s)
data ResultInfo s r = ResultInfo !s !r
instance (Show s, Show r) => Show (ResultList s r) where
show :: ResultList s r -> String
show (ResultList BinTree (ResultInfo s r)
l ParseFailure (Down Int) s
f) = String
"ResultList (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows BinTree (ResultInfo s r)
l (String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows ParseFailure (Down Int) s
f String
")")
instance Show s => Show1 (ResultList s) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList s a -> ShowS
liftShowsPrec Int -> a -> ShowS
_sp [a] -> ShowS
showList Int
_prec (ResultList BinTree (ResultInfo s a)
l ParseFailure (Down Int) s
f) String
rest = String
"ResultList " forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (forall {s} {r}. ResultInfo s r -> r
simplify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s a)
l) (forall a. Show a => a -> ShowS
shows ParseFailure (Down Int) s
f String
rest)
where simplify :: ResultInfo s r -> r
simplify (ResultInfo s
_ r
r) = r
r
instance (Show s, Show r) => Show (ResultInfo s r) where
show :: ResultInfo s r -> String
show (ResultInfo s
s r
r) = String
"(ResultInfo @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show s
s forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows r
r String
")"
instance Functor (ResultInfo s) where
fmap :: forall a b. (a -> b) -> ResultInfo s a -> ResultInfo s b
fmap a -> b
f (ResultInfo s
s a
r) = forall s r. s -> r -> ResultInfo s r
ResultInfo s
s (a -> b
f a
r)
instance Foldable (ResultInfo s) where
foldMap :: forall m a. Monoid m => (a -> m) -> ResultInfo s a -> m
foldMap a -> m
f (ResultInfo s
_ a
r) = a -> m
f a
r
instance Traversable (ResultInfo s) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultInfo s a -> f (ResultInfo s b)
traverse a -> f b
f (ResultInfo s
s a
r) = forall s r. s -> r -> ResultInfo s r
ResultInfo s
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
r
instance Filterable (ResultList s) where
mapMaybe :: forall a b. (a -> Maybe b) -> ResultList s a -> ResultList s b
mapMaybe a -> Maybe b
f (ResultList BinTree (ResultInfo s a)
l ParseFailure (Down Int) s
failure) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Maybe b
f) BinTree (ResultInfo s a)
l) ParseFailure (Down Int) s
failure
instance Functor (ResultList s) where
fmap :: forall a b. (a -> b) -> ResultList s a -> ResultList s b
fmap a -> b
f (ResultList BinTree (ResultInfo s a)
l ParseFailure (Down Int) s
failure) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList ((a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
l) ParseFailure (Down Int) s
failure
instance Ord s => Semigroup (ResultList s r) where
ResultList BinTree (ResultInfo s r)
rl1 ParseFailure (Down Int) s
f1 <> :: ResultList s r -> ResultList s r -> ResultList s r
<> ResultList BinTree (ResultInfo s r)
rl2 ParseFailure (Down Int) s
f2 = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (BinTree (ResultInfo s r)
rl1 forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo s r)
rl2) (ParseFailure (Down Int) s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure (Down Int) s
f2)
instance Ord s => Monoid (ResultList s r) where
mempty :: ResultList s r
mempty = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty forall s. ParseFailure (Down Int) s
noFailure
mappend :: ResultList s r -> ResultList s r -> ResultList s r
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Functor (Parser g s) where
fmap :: forall a b. (a -> b) -> Parser g s a -> Parser g s b
fmap a -> b
f (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a
p)
instance Ord s => Applicative (Parser g s) where
pure :: forall a. a -> Parser g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
rest-> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest a
a) forall s. ParseFailure (Down Int) s
noFailure)
Parser s -> ResultList s (a -> b)
p <*> :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser s -> ResultList s a
q = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s b
r where
r :: s -> ResultList s b
r s
rest = case s -> ResultList s (a -> b)
p s
rest
of ResultList BinTree (ResultInfo s (a -> b))
results ParseFailure (Down Int) s
failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s (a -> b) -> ResultList s b
continue BinTree (ResultInfo s (a -> b))
results
continue :: ResultInfo s (a -> b) -> ResultList s b
continue (ResultInfo s
rest' a -> b
f) = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> ResultList s a
q s
rest'
instance (FactorialMonoid s, Ord s) => Alternative (Parser g s) where
empty :: forall a. Parser g s a
empty = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Down Int
fromEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Factorial m => m -> Int
Factorial.length)
Parser s -> ResultList s a
p <|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<|> Parser s -> ResultList s a
q = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
r where
r :: s -> ResultList s a
r s
rest = s -> ResultList s a
p s
rest forall a. Semigroup a => a -> a -> a
<> s -> ResultList s a
q s
rest
instance FactorialMonoid s => Filterable (Parser g s) where
mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a
p)
#if MIN_VERSION_base(4,13,0)
instance Ord s => Monad (Parser g s) where
#else
instance (Factorial.FactorialMonoid s, Ord s) => Monad (Parser g s) where
#endif
return :: forall a. a -> Parser g s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Parser s -> ResultList s a
p >>= :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s b
q where
q :: s -> ResultList s b
q s
rest = case s -> ResultList s a
p s
rest
of ResultList BinTree (ResultInfo s a)
results ParseFailure (Down Int) s
failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty ParseFailure (Down Int) s
failure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s a -> ResultList s b
continue BinTree (ResultInfo s a)
results
continue :: ResultInfo s a -> ResultList s b
continue (ResultInfo s
rest' a
a) = forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
applyParser (a -> Parser g s b
f a
a) s
rest'
#if MIN_VERSION_base(4,13,0)
instance (FactorialMonoid s, Ord s) => MonadFail (Parser g s) where
#endif
fail :: forall a. String -> Parser g s a
fail String
msg = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
s-> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
msg)
instance (FactorialMonoid s, Ord s) => MonadPlus (Parser g s) where
mzero :: forall a. Parser g s a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. Parser g s a -> Parser g s a -> Parser g s a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance (Ord s, Semigroup x) => Semigroup (Parser g s x) where
<> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
instance (Monoid x, Ord s) => Monoid (Parser g s x) where
mempty :: Parser g s x
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance (Cancellative.LeftReductive s, FactorialMonoid s, Ord s) => MultiParsing (Parser g s) where
type ResultFunctor (Parser g s) = Compose (ParseResults s) []
parsePrefix :: forall s (g :: (* -> *) -> *).
(ParserInput (Parser g s) ~ s, GrammarConstraint (Parser g s) g,
Eq s, FactorialMonoid s) =>
g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s r.
(Eq s, FactorialMonoid s) =>
ResultList s r -> ParseResults s [(s, r)]
fromResultList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
`applyParser` s
input)) g (Parser g s)
g
parseComplete :: (Rank2.Functor g', Eq s, FactorialMonoid s) =>
g' (Parser g s) -> s -> g' (Compose (ParseResults s) [])
parseComplete :: forall (g' :: (* -> *) -> *).
(Functor g', Eq s, FactorialMonoid s) =>
g' (Parser g s) -> s -> g' (Compose (ParseResults s) [])
parseComplete g' (Parser g s)
g s
input = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
FactorialMonoid s) =>
g m -> s -> g (Compose (ResultFunctor m) ((,) s))
parsePrefix (forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
eof) g' (Parser g s)
g) s
input)
instance (Cancellative.LeftReductive s, FactorialMonoid s, Ord s) => InputParsing (Parser g s) where
type ParserInput (Parser g s) = s
getInput :: Parser g s (ParserInput (Parser g s))
getInput = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser forall {r}. r -> ResultList r r
p
where p :: r -> ResultList r r
p r
s = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo r
s r
s) forall s. ParseFailure (Down Int) s
noFailure
anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser forall {m}. FactorialMonoid m => m -> ResultList m m
p
where p :: m -> ResultList m m
p m
s = case forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
s
of Just (m
first, m
rest) -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo m
rest m
first) forall s. ParseFailure (Down Int) s
noFailure
Maybe (m, m)
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length m
s) String
"anyToken")
satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s = case forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
of Just (s
first, s
rest) | ParserInput (Parser g s) -> Bool
predicate s
first -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest s
first) forall s. ParseFailure (Down Int) s
noFailure
Maybe (s, s)
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"satisfy")
notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s ()
p
where p :: s -> ResultList s ()
p s
s = case forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
of Just (s
first, s
_)
| ParserInput (Parser g s) -> Bool
predicate s
first -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfy")
Maybe (s, s)
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) forall s. ParseFailure (Down Int) s
noFailure
scan :: forall state.
state
-> (state -> ParserInput (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan state
s0 state -> ParserInput (Parser g s) -> Maybe state
f = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (state -> s -> ResultList s s
p state
s0)
where p :: state -> s -> ResultList s s
p state
s s
i = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
where (s
prefix, s
suffix, state
_) = forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> ParserInput (Parser g s) -> Maybe state
f s
i
take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s
| (s
prefix, s
suffix) <- forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n s
s,
forall m. Factorial m => m -> Int
Factorial.length s
prefix forall a. Eq a => a -> a -> Bool
== Int
n = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
| Bool
otherwise = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) forall a b. (a -> b) -> a -> b
$ String
"take " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
where (s
prefix, s
suffix) = forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span ParserInput (Parser g s) -> Bool
predicate s
s
takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s | (s
prefix, s
suffix) <- forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span ParserInput (Parser g s) -> Bool
predicate s
s =
if forall m. MonoidNull m => m -> Bool
Null.null s
prefix
then forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"takeWhile1")
else forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p where
p :: s -> ResultList s s
p s
s' | Just s
suffix <- forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix ParserInput (Parser g s)
s s
s' = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix ParserInput (Parser g s)
s) forall s. ParseFailure (Down Int) s
noFailure
| Bool
otherwise = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> s -> ParseFailure (Down Int) s
expectedInput (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s') ParserInput (Parser g s)
s)
instance (FactorialMonoid s, InputParsing (Parser g s)) => TraceableParsing (Parser g s) where
traceInput :: forall a.
(ParserInput (Parser g s) -> String)
-> Parser g s a -> Parser g s a
traceInput ParserInput (Parser g s) -> String
description (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
q
where q :: s -> ResultList s a
q s
s = case forall a. String -> a -> a
trace (String
"Parsing " forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
s) (s -> ResultList s a
p s
s)
of rl :: ResultList s a
rl@(ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
_) -> forall a. String -> a -> a
trace (String
"Failed " forall a. Semigroup a => a -> a -> a
<> ParserInput (Parser g s) -> String
description s
s) ResultList s a
rl
rl :: ResultList s a
rl@(ResultList BinTree (ResultInfo s a)
rs ParseFailure (Down Int) s
_) ->
forall a. String -> a -> a
trace (String
"Parsed [" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ResultInfo s a -> String
describeResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s a)
rs) forall a. Semigroup a => a -> a -> a
<> String
"]") ResultList s a
rl
where describeResult :: ResultInfo s a -> String
describeResult (ResultInfo s
s' a
_) =
ParserInput (Parser g s) -> String
description (forall m. FactorialMonoid m => Int -> m -> m
Factorial.take (forall m. Factorial m => m -> Int
Factorial.length s
s forall a. Num a => a -> a -> a
- forall m. Factorial m => m -> Int
Factorial.length s
s') s
s)
instance (Ord s, TextualMonoid s) => InputCharParsing (Parser g s) where
satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s =
case forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
of Just (Char
first, s
rest)
| Char -> Bool
predicate Char
first -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> m
Factorial.primePrefix s
s) forall s. ParseFailure (Down Int) s
noFailure
Maybe (Char, s)
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"satisfyCharInput")
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s ()
p
where p :: s -> ResultList s ()
p s
s = case forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first | Char -> Bool
predicate Char
first
-> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfyChar")
Maybe Char
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) forall s. ParseFailure (Down Int) s
noFailure
scanChars :: forall state.
state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (state -> s -> ResultList s s
p state
s0)
where p :: state -> s -> ResultList s s
p state
s s
i = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
where (s
prefix, s
suffix, state
_) = forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s | (s
prefix, s
suffix) <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s =
forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
p
where p :: s -> ResultList s s
p s
s | (s
prefix, s
suffix) <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s =
if forall m. MonoidNull m => m -> Bool
null s
prefix
then forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"takeCharsWhile1")
else forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) forall s. ParseFailure (Down Int) s
noFailure
instance (FactorialMonoid s, Ord s) => Parsing (Parser g s) where
try :: forall a. Parser g s a -> Parser g s a
try (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
q
where q :: s -> ResultList s a
q s
rest = ResultList s a -> ResultList s a
rewindFailure (s -> ResultList s a
p s
rest)
where rewindFailure :: ResultList s a -> ResultList s a
rewindFailure (ResultList BinTree (ResultInfo s a)
rl ParseFailure (Down Int) s
_) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList BinTree (ResultInfo s a)
rl (forall s. Down Int -> ParseFailure (Down Int) s
emptyFailure forall a b. (a -> b) -> a -> b
$ Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
rest)
Parser s -> ResultList s a
p <?> :: forall a. Parser g s a -> String -> Parser g s a
<?> String
msg = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
q
where q :: s -> ResultList s a
q s
rest = ResultList s a -> ResultList s a
replaceFailure (s -> ResultList s a
p s
rest)
where replaceFailure :: ResultList s a -> ResultList s a
replaceFailure (ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
f) =
forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. BinTree a
EmptyTree (forall s.
Down Int
-> String -> ParseFailure (Down Int) s -> ParseFailure (Down Int) s
replaceExpected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
rest) String
msg ParseFailure (Down Int) s
f)
replaceFailure ResultList s a
rl = ResultList s a
rl
notFollowedBy :: forall a. Show a => Parser g s a -> Parser g s ()
notFollowedBy (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
input-> forall {m} {s} {r}.
Factorial m =>
m -> ResultList s r -> ResultList m ()
rewind s
input (s -> ResultList s a
p s
input))
where rewind :: m -> ResultList s r -> ResultList m ()
rewind m
t (ResultList BinTree (ResultInfo s r)
EmptyTree ParseFailure (Down Int) s
_) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo m
t ()) forall s. ParseFailure (Down Int) s
noFailure
rewind m
t ResultList{} = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length m
t) String
"notFollowedBy")
skipMany :: forall a. Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
where go :: Parser g s ()
go = forall (f :: * -> *) a. Applicative f => a -> f a
pure () forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser g s a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
unexpected :: forall a. String -> Parser g s a
unexpected String
msg = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
t-> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s. Down Int -> String -> ParseFailure (Down Int) s
erroneous (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
t) String
msg)
eof :: Parser g s ()
eof = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser forall {m}. (MonoidNull m, Factorial m) => m -> ResultList m ()
f
where f :: m -> ResultList m ()
f m
s | forall m. MonoidNull m => m -> Bool
null m
s = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo m
s ()) forall s. ParseFailure (Down Int) s
noFailure
| Bool
otherwise = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length m
s) String
"end of input")
instance (FactorialMonoid s, Ord s) => DeterministicParsing (Parser g s) where
Parser s -> ResultList s a
p <<|> :: forall a. Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser s -> ResultList s a
q = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
r where
r :: s -> ResultList s a
r s
rest = case s -> ResultList s a
p s
rest
of rl :: ResultList s a
rl@(ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
_failure) -> ResultList s a
rl forall a. Semigroup a => a -> a -> a
<> s -> ResultList s a
q s
rest
ResultList s a
rl -> ResultList s a
rl
takeSome :: forall a. Parser g s a -> Parser g s [a]
takeSome Parser g s a
p = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany Parser g s a
p
takeMany :: forall a. Parser g s a -> Parser g s [a]
takeMany (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (([a] -> [a]) -> s -> ResultList s [a]
q forall a. a -> a
id) where
q :: ([a] -> [a]) -> s -> ResultList s [a]
q [a] -> [a]
acc s
rest = case s -> ResultList s a
p s
rest
of ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
_failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ([a] -> [a]
acc [])) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo s a)
rl ParseFailure (Down Int) s
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s a -> ResultList s [a]
continue BinTree (ResultInfo s a)
rl
where continue :: ResultInfo s a -> ResultList s [a]
continue (ResultInfo s
rest' a
result) = ([a] -> [a]) -> s -> ResultList s [a]
q ([a] -> [a]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
resultforall a. a -> [a] -> [a]
:)) s
rest'
skipAll :: forall a. Parser g s a -> Parser g s ()
skipAll (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s ()
q where
q :: s -> ResultList s ()
q s
rest = case s -> ResultList s a
p s
rest
of ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
_failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ()) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo s a)
rl ParseFailure (Down Int) s
_failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s a -> ResultList s ()
continue BinTree (ResultInfo s a)
rl
where continue :: ResultInfo s a -> ResultList s ()
continue (ResultInfo s
rest' a
_) = s -> ResultList s ()
q s
rest'
instance (FactorialMonoid s, Ord s) => CommittedParsing (Parser g s) where
type CommittedResults (Parser g s) = ParseResults s
commit :: forall a.
Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s (Either (ParseFailure (Down Int) s) a)
q
where q :: s -> ResultList s (Either (ParseFailure (Down Int) s) a)
q s
rest = case s -> ResultList s a
p s
rest
of ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure (Down Int) s
failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure) forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo s a)
rl ParseFailure (Down Int) s
failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
rl) ParseFailure (Down Int) s
failure
admit :: forall a.
Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser s -> ResultList s (CommittedResults (Parser g s) a)
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s a
q
where q :: s -> ResultList s a
q s
rest = case s -> ResultList s (CommittedResults (Parser g s) a)
p s
rest
of ResultList BinTree (ResultInfo s (CommittedResults (Parser g s) a))
EmptyTree ParseFailure (Down Int) s
failure -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. BinTree a
EmptyTree ParseFailure (Down Int) s
failure
ResultList BinTree (ResultInfo s (CommittedResults (Parser g s) a))
rl ParseFailure (Down Int) s
failure -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {s} {r}.
Ord s =>
ResultInfo s (Either (ParseFailure (Down Int) s) r)
-> ResultList s r
expose BinTree (ResultInfo s (CommittedResults (Parser g s) a))
rl forall a. Semigroup a => a -> a -> a
<> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. BinTree a
EmptyTree ParseFailure (Down Int) s
failure
expose :: ResultInfo s (Either (ParseFailure (Down Int) s) r)
-> ResultList s r
expose (ResultInfo s
_ (Left ParseFailure (Down Int) s
failure)) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. BinTree a
EmptyTree ParseFailure (Down Int) s
failure
expose (ResultInfo s
rest (Right r
r)) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest r
r) forall a. Monoid a => a
mempty
instance (FactorialMonoid s, Ord s) => LookAheadParsing (Parser g s) where
lookAhead :: forall a. Parser g s a -> Parser g s a
lookAhead (Parser s -> ResultList s a
p) = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
input-> forall {s} {r}. s -> ResultList s r -> ResultList s r
rewind s
input (s -> ResultList s a
p s
input))
where rewind :: s -> ResultList s r -> ResultList s r
rewind s
t (ResultList BinTree (ResultInfo s r)
rl ParseFailure (Down Int) s
failure) = forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall {s} {s} {r}. s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r)
rl) ParseFailure (Down Int) s
failure
rewindInput :: s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t (ResultInfo s
_ r
r) = forall s r. s -> r -> ResultInfo s r
ResultInfo s
t r
r
instance (TextualMonoid s, Ord s) => CharParsing (Parser g s) where
satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s Char
p
where p :: s -> ResultList s Char
p s
s =
case forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
of Just (Char
first, s
rest) | Char -> Bool
predicate Char
first -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList (forall a. a -> BinTree a
Leaf forall a b. (a -> b) -> a -> b
$ forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest Char
first) forall s. ParseFailure (Down Int) s
noFailure
Maybe (Char, s)
_ -> forall s r.
BinTree (ResultInfo s r)
-> ParseFailure (Down Int) s -> ResultList s r
ResultList forall a. Monoid a => a
mempty (forall s. Down Int -> String -> ParseFailure (Down Int) s
expected (Int -> Down Int
fromEnd forall a b. (a -> b) -> a -> b
$ forall m. Factorial m => m -> Int
Factorial.length s
s) String
"Char.satisfy")
string :: String -> Parser g s String
string String
s = forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall a. IsString a => String -> a
fromString String
s)
text :: Text -> Parser g s Text
text Text
t = (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. TextualMonoid t => (t -> String) -> t -> String
Textual.toString (forall a. HasCallStack => String -> a
error String
"unexpected non-character")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)
fromResultList :: (Eq s, FactorialMonoid s) => ResultList s r -> ParseResults s [(s, r)]
fromResultList :: forall s r.
(Eq s, FactorialMonoid s) =>
ResultList s r -> ParseResults s [(s, r)]
fromResultList (ResultList BinTree (ResultInfo s r)
EmptyTree ParseFailure (Down Int) s
failure) = forall a b. a -> Either a b
Left ParseFailure (Down Int) s
failure
fromResultList (ResultList BinTree (ResultInfo s r)
rl ParseFailure (Down Int) s
_failure) = forall a b. b -> Either a b
Right (forall {a} {b}. ResultInfo a b -> (a, b)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s r)
rl)
where f :: ResultInfo a b -> (a, b)
f (ResultInfo a
s b
r) = (a
s, b
r)