{-# LANGUAGE FlexibleContexts, InstanceSigs, GeneralizedNewtypeDeriving,
RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.Parallel (FailureInfo(..), ResultList(..), Parser, fromResultList)
where
import Control.Applicative
import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (nub)
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 qualified Rank2
import Text.Grampa.Class (DeterministicParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (BinTree(..), FailureInfo(..), noFailure, TraceableParsing(..))
import Prelude hiding (iterate, null, showList, span, takeWhile)
newtype Parser (g :: (* -> *) -> *) s r = Parser{Parser g s r -> s -> ResultList s r
applyParser :: s -> ResultList s r}
data ResultList s r = ResultList !(BinTree (ResultInfo s r)) {-# UNPACK #-} !(FailureInfo 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 FailureInfo s
f) = String
"ResultList (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinTree (ResultInfo s r) -> ShowS
forall a. Show a => a -> ShowS
shows BinTree (ResultInfo s r)
l (String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f String
")")
instance Show s => Show1 (ResultList s) where
liftShowsPrec :: (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 FailureInfo s
f) String
rest = String
"ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (ResultInfo s a -> a
forall s r. ResultInfo s r -> r
simplify (ResultInfo s a -> a) -> [ResultInfo s a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a) -> [ResultInfo s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s a)
l) (FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo 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 @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> ShowS
forall a. Show a => a -> ShowS
shows r
r String
")"
instance Functor (ResultInfo s) where
fmap :: (a -> b) -> ResultInfo s a -> ResultInfo s b
fmap a -> b
f (ResultInfo s
s a
r) = s -> b -> ResultInfo s b
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s (a -> b
f a
r)
instance Foldable (ResultInfo s) where
foldMap :: (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 :: (a -> f b) -> ResultInfo s a -> f (ResultInfo s b)
traverse a -> f b
f (ResultInfo s
s a
r) = s -> b -> ResultInfo s b
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s (b -> ResultInfo s b) -> f b -> f (ResultInfo s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
r
instance Filterable (ResultList s) where
mapMaybe :: (a -> Maybe b) -> ResultList s a -> ResultList s b
mapMaybe a -> Maybe b
f (ResultList BinTree (ResultInfo s a)
l FailureInfo s
failure) = BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList ((ResultInfo s a -> Maybe (ResultInfo s b))
-> BinTree (ResultInfo s a) -> BinTree (ResultInfo s b)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((a -> Maybe b) -> ResultInfo s a -> Maybe (ResultInfo s b)
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) FailureInfo s
failure
instance Functor (ResultList s) where
fmap :: (a -> b) -> ResultList s a -> ResultList s b
fmap a -> b
f (ResultList BinTree (ResultInfo s a)
l FailureInfo s
failure) = BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList ((a -> b
f (a -> b) -> ResultInfo s a -> ResultInfo s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo s a -> ResultInfo s b)
-> BinTree (ResultInfo s a) -> BinTree (ResultInfo s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
l) FailureInfo s
failure
instance Semigroup (ResultList s r) where
ResultList BinTree (ResultInfo s r)
rl1 FailureInfo s
f1 <> :: ResultList s r -> ResultList s r -> ResultList s r
<> ResultList BinTree (ResultInfo s r)
rl2 FailureInfo s
f2 = BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (BinTree (ResultInfo s r)
rl1 BinTree (ResultInfo s r)
-> BinTree (ResultInfo s r) -> BinTree (ResultInfo s r)
forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo s r)
rl2) (FailureInfo s
f1 FailureInfo s -> FailureInfo s -> FailureInfo s
forall a. Semigroup a => a -> a -> a
<> FailureInfo s
f2)
instance Monoid (ResultList s r) where
mempty :: ResultList s r
mempty = BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s r)
forall a. Monoid a => a
mempty FailureInfo s
forall s. FailureInfo s
noFailure
mappend :: ResultList s r -> ResultList s r -> ResultList s r
mappend = ResultList s r -> ResultList s r -> ResultList s r
forall a. Semigroup a => a -> a -> a
(<>)
instance Functor (Parser g s) where
fmap :: (a -> b) -> Parser g s a -> Parser g s b
fmap a -> b
f (Parser s -> ResultList s a
p) = (s -> ResultList s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser ((a -> b) -> ResultList s a -> ResultList s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ResultList s a -> ResultList s b)
-> (s -> ResultList s a) -> s -> ResultList s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a
p)
instance Applicative (Parser g s) where
pure :: a -> Parser g s a
pure a
a = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
rest-> BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s a -> BinTree (ResultInfo s a)
forall a. a -> BinTree a
Leaf (ResultInfo s a -> BinTree (ResultInfo s a))
-> ResultInfo s a -> BinTree (ResultInfo s a)
forall a b. (a -> b) -> a -> b
$ s -> a -> ResultInfo s a
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest a
a) FailureInfo s
forall s. FailureInfo s
noFailure)
Parser s -> ResultList s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser s -> ResultList s a
q = (s -> ResultList s b) -> Parser g s b
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 FailureInfo s
failure -> BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo s
failure ResultList s b -> ResultList s b -> ResultList s b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo s (a -> b) -> ResultList s b)
-> BinTree (ResultInfo s (a -> b)) -> ResultList s b
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 (a -> b) -> ResultList s a -> ResultList s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> ResultList s a
q s
rest'
instance FactorialMonoid s => Alternative (Parser g s) where
empty :: Parser g s a
empty = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
s-> BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList s a)
-> FailureInfo s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"empty"])
Parser s -> ResultList s a
p <|> :: Parser g s a -> Parser g s a -> Parser g s a
<|> Parser s -> ResultList s a
q = (s -> ResultList s a) -> Parser g s a
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 ResultList s a -> ResultList s a -> ResultList s a
forall a. Semigroup a => a -> a -> a
<> s -> ResultList s a
q s
rest
instance FactorialMonoid s => Filterable (Parser g s) where
mapMaybe :: (a -> Maybe b) -> Parser g s a -> Parser g s b
mapMaybe a -> Maybe b
f (Parser s -> ResultList s a
p) = (s -> ResultList s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser ((a -> Maybe b) -> ResultList s a -> ResultList s b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f (ResultList s a -> ResultList s b)
-> (s -> ResultList s a) -> s -> ResultList s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a
p)
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 -> ResultList s a
p >>= :: Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= a -> Parser g s b
f = (s -> ResultList s b) -> Parser g s b
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 FailureInfo s
failure -> BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo s
failure ResultList s b -> ResultList s b -> ResultList s b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo s a -> ResultList s b)
-> BinTree (ResultInfo s a) -> ResultList s b
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) = Parser g s b -> s -> ResultList s b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
applyParser (a -> Parser g s b
f a
a) s
rest'
instance FactorialMonoid s => MonadFail (Parser g s) where
fail :: String -> Parser g s a
fail String
msg = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
s-> BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList s a)
-> FailureInfo s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
instance FactorialMonoid s => MonadPlus (Parser g s) where
mzero :: Parser g s a
mzero = Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Parser g s a -> Parser g s a -> Parser g s a
mplus = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance Semigroup x => Semigroup (Parser g s x) where
<> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid x => Monoid (Parser g s x) where
mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Monoid a => a -> a -> a
mappend
instance (Cancellative.LeftReductive s, FactorialMonoid s) => MultiParsing (Parser g s) where
type ResultFunctor (Parser g s) = Compose (ParseResults s) []
parsePrefix :: g (Parser g s)
-> s -> g (Compose (ResultFunctor (Parser g s)) ((,) s))
parsePrefix g (Parser g s)
g s
input = (forall a.
Parser g s a -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (Parser g s)
-> g (Compose (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 (Compose (Either (ParseFailure s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a)
-> (Parser g s a -> Compose (Either (ParseFailure s)) [] (s, a))
-> Parser g s a
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a))
-> (Parser g s a -> Either (ParseFailure s) [(s, a)])
-> Parser g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a -> Either (ParseFailure s) [(s, a)]
forall s r.
(Eq s, FactorialMonoid s) =>
s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList s
input (ResultList s a -> Either (ParseFailure s) [(s, a)])
-> (Parser g s a -> ResultList s a)
-> Parser g s a
-> Either (ParseFailure s) [(s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser g s a -> s -> ResultList s a
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 :: g' (Parser g s) -> s -> g' (Compose (ParseResults s) [])
parseComplete g' (Parser g s)
g s
input = (forall a.
Compose (ResultFunctor (Parser g s)) ((,) s) a
-> Compose (ParseResults s) [] a)
-> g' (Compose (ResultFunctor (Parser g s)) ((,) s))
-> g' (Compose (ParseResults s) [])
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a)
-> (Compose (Compose (ParseResults s) []) ((,) s) a
-> Compose (ParseResults s) [] (s, a))
-> Compose (Compose (ParseResults s) []) ((,) s) a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Compose (ParseResults s) []) ((,) s) a
-> Compose (ParseResults s) [] (s, a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (g' (Parser g s)
-> s -> g' (Compose (ResultFunctor (Parser g s)) ((,) s))
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 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) s
input)
instance (Cancellative.LeftReductive s, FactorialMonoid s) => InputParsing (Parser g s) where
type ParserInput (Parser g s) = s
getInput :: Parser g s (ParserInput (Parser g s))
getInput = (s -> ResultList s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
forall r. r -> ResultList r r
p
where p :: r -> ResultList r r
p r
s = BinTree (ResultInfo r r) -> FailureInfo r -> ResultList r r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo r r -> BinTree (ResultInfo r r)
forall a. a -> BinTree a
Leaf (ResultInfo r r -> BinTree (ResultInfo r r))
-> ResultInfo r r -> BinTree (ResultInfo r r)
forall a b. (a -> b) -> a -> b
$ r -> r -> ResultInfo r r
forall s r. s -> r -> ResultInfo s r
ResultInfo r
s r
s) FailureInfo r
forall s. FailureInfo s
noFailure
anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = (s -> ResultList s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
forall m. FactorialMonoid m => m -> ResultList m m
p
where p :: m -> ResultList m m
p m
s = case m -> Maybe (m, m)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
s
of Just (m
first, m
rest) -> BinTree (ResultInfo m m) -> FailureInfo m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m m -> BinTree (ResultInfo m m)
forall a. a -> BinTree a
Leaf (ResultInfo m m -> BinTree (ResultInfo m m))
-> ResultInfo m m -> BinTree (ResultInfo m m)
forall a b. (a -> b) -> a -> b
$ m -> m -> ResultInfo m m
forall s r. s -> r -> ResultInfo s r
ResultInfo m
rest m
first) FailureInfo m
forall s. FailureInfo s
noFailure
Maybe (m, m)
_ -> BinTree (ResultInfo m m) -> FailureInfo m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m m)
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) [String -> Expected m
forall s. String -> Expected s
Expected String
"anyToken"])
satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy ParserInput (Parser g s) -> Bool
predicate = (s -> ResultList s s) -> 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 = case s -> Maybe (s, s)
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
ParserInput (Parser g s)
first -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest s
first) FailureInfo s
forall s. FailureInfo s
noFailure
Maybe (s, s)
_ -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfy"])
notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy ParserInput (Parser g s) -> Bool
predicate = (s -> ResultList s ()) -> Parser g s ()
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 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 -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfy"])
Maybe (s, s)
_ -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo s
forall s. FailureInfo s
noFailure
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 -> ResultList s s) -> Parser g s s
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 = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
where (s
prefix, s
suffix, state
_) = state -> (state -> s -> Maybe state) -> s -> (s, s, state)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' state
s state -> s -> Maybe state
state -> ParserInput (Parser g s) -> Maybe state
f s
i
take :: Int -> Parser g s (ParserInput (Parser g s))
take Int
n = (s -> ResultList s s) -> 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
| (s
prefix, s
suffix) <- Int -> s -> (s, s)
forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n s
s,
s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
| Bool
otherwise = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected (String -> Expected s) -> String -> Expected s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
takeWhile :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile ParserInput (Parser g s) -> Bool
predicate = (s -> ResultList s s) -> 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 = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
where (s
prefix, s
suffix) = (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s
takeWhile1 :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
takeWhile1 ParserInput (Parser g s) -> Bool
predicate = (s -> ResultList s s) -> 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 | (s
prefix, s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s =
if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
then BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeWhile1"])
else BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string ParserInput (Parser g s)
s = (s -> ResultList s s) -> 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 <- s -> s -> Maybe s
forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix s
ParserInput (Parser g s)
s s
s' = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
ParserInput (Parser g s)
s) FailureInfo s
forall s. FailureInfo s
noFailure
| Bool
otherwise = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') [s -> Expected s
forall s. s -> Expected s
ExpectedInput s
ParserInput (Parser g s)
s])
instance InputParsing (Parser g 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 -> ResultList s a
p) = (s -> ResultList s a) -> Parser g s a
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 String -> ResultList s a -> ResultList s a
traceWith String
"Parsing " (s -> ResultList s a
p s
s)
of rl :: ResultList s a
rl@(ResultList BinTree (ResultInfo s a)
EmptyTree FailureInfo s
_) -> String -> ResultList s a -> ResultList s a
traceWith String
"Failed " ResultList s a
rl
ResultList s a
rl -> String -> ResultList s a -> ResultList s a
traceWith String
"Parsed " ResultList s a
rl
where traceWith :: String -> ResultList s a -> ResultList s a
traceWith String
prefix = String -> ResultList s a -> ResultList 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 s
ParserInput (Parser g s)
s)
instance TextualMonoid s => InputCharParsing (Parser g s) where
satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
satisfyCharInput Char -> Bool
predicate = (s -> ResultList s s) -> 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 =
case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
of Just (Char
first, s
rest)
| Char -> Bool
predicate Char
first -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest (s -> ResultInfo s s) -> s -> ResultInfo s s
forall a b. (a -> b) -> a -> b
$ s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) FailureInfo s
forall s. FailureInfo s
noFailure
Maybe (Char, s)
_ -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"satisfyCharInput"])
notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar Char -> Bool
predicate = (s -> ResultList s ()) -> Parser g s ()
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 s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
of Just Char
first
| Char -> Bool
predicate Char
first -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"notSatisfyChar"])
Maybe Char
_ -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo s
forall s. FailureInfo s
noFailure
scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars state
s0 state -> Char -> Maybe state
f = (s -> ResultList s s) -> Parser g s s
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 = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
where (s
prefix, s
suffix, state
_) = state -> (state -> Char -> Maybe state) -> s -> (s, s, state)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' state
s state -> Char -> Maybe state
f s
i
takeCharsWhile :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile Char -> Bool
predicate = (s -> ResultList s s) -> 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 | (s
prefix, s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s =
BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 Char -> Bool
predicate = (s -> ResultList s s) -> 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 | (s
prefix, s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s =
if s -> Bool
forall m. MonoidNull m => m -> Bool
null s
prefix
then BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"takeCharsWhile1"])
else BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
instance FactorialMonoid s => Parsing (Parser g s) where
try :: Parser g s a -> Parser g s a
try (Parser s -> ResultList s a
p) = (s -> ResultList s a) -> Parser g s a
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 (FailureInfo Int
_pos [Expected s]
_msgs)) =
BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
rl (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [])
Parser s -> ResultList s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> String
msg = (s -> ResultList s a) -> Parser g s a
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 (FailureInfo Int
pos [Expected s]
msgs)) =
BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected s] -> FailureInfo s) -> [Expected s] -> FailureInfo s
forall a b. (a -> b) -> a -> b
$
if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest then [String -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
msgs)
replaceFailure ResultList s a
rl = ResultList s a
rl
notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser s -> ResultList s a
p) = (s -> ResultList s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
input-> s -> ResultList s a -> ResultList s ()
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 FailureInfo s
_) = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
t ()) FailureInfo m
forall s. FailureInfo s
noFailure
rewind m
t ResultList{} = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
t) [String -> Expected m
forall s. String -> Expected s
Expected String
"notFollowedBy"])
skipMany :: Parser g s a -> Parser g s ()
skipMany Parser g s a
p = Parser g s ()
go
where go :: Parser g s ()
go = () -> Parser g s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Parser g s () -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser g s a -> Parser g s a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser g s a
p Parser g s a -> Parser g s () -> Parser g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser g s ()
go
unexpected :: String -> Parser g s a
unexpected String
msg = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
t-> BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList s a)
-> FailureInfo s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
eof :: Parser g s ()
eof = (s -> ResultList s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s ()
forall m. (MonoidNull m, Factorial m) => m -> ResultList m ()
f
where f :: m -> ResultList m ()
f m
s | m -> Bool
forall m. MonoidNull m => m -> Bool
null m
s = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
s ()) FailureInfo m
forall s. FailureInfo s
noFailure
| Bool
otherwise = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) [String -> Expected m
forall s. String -> Expected s
Expected String
"end of input"])
instance FactorialMonoid s => DeterministicParsing (Parser g s) where
Parser s -> ResultList s a
p <<|> :: Parser g s a -> Parser g s a -> Parser g s a
<<|> Parser s -> ResultList s a
q = (s -> ResultList s a) -> Parser g s a
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 FailureInfo s
_failure) -> ResultList s a
rl ResultList s a -> ResultList s a -> ResultList s a
forall a. Semigroup a => a -> a -> a
<> s -> ResultList s a
q s
rest
ResultList s a
rl -> ResultList s a
rl
takeSome :: Parser g s a -> Parser g s [a]
takeSome Parser g s a
p = (:) (a -> [a] -> [a]) -> Parser g s a -> Parser g s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser g s a
p Parser g s ([a] -> [a]) -> Parser g s [a] -> Parser g s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser g s a -> Parser g s [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany Parser g s a
p
takeMany :: Parser g s a -> Parser g s [a]
takeMany (Parser s -> ResultList s a
p) = (s -> ResultList s [a]) -> Parser g s [a]
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (([a] -> [a]) -> s -> ResultList s [a]
q [a] -> [a]
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 FailureInfo s
_failure -> BinTree (ResultInfo s [a]) -> FailureInfo s -> ResultList s [a]
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s [a] -> BinTree (ResultInfo s [a])
forall a. a -> BinTree a
Leaf (ResultInfo s [a] -> BinTree (ResultInfo s [a]))
-> ResultInfo s [a] -> BinTree (ResultInfo s [a])
forall a b. (a -> b) -> a -> b
$ s -> [a] -> ResultInfo s [a]
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ([a] -> [a]
acc [])) FailureInfo s
forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo s a)
rl FailureInfo s
_ -> (ResultInfo s a -> ResultList s [a])
-> BinTree (ResultInfo s a) -> ResultList s [a]
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 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
resulta -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) s
rest'
skipAll :: Parser g s a -> Parser g s ()
skipAll (Parser s -> ResultList s a
p) = (s -> ResultList s ()) -> Parser g s ()
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 FailureInfo s
_failure -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ()) FailureInfo s
forall a. Monoid a => a
mempty
ResultList BinTree (ResultInfo s a)
rl FailureInfo s
_failure -> (ResultInfo s a -> ResultList s ())
-> BinTree (ResultInfo s a) -> ResultList s ()
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 => LookAheadParsing (Parser g s) where
lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser s -> ResultList s a
p) = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s
input-> s -> ResultList s a -> ResultList s a
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 FailureInfo s
failure) = BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (s -> ResultInfo s r -> ResultInfo s r
forall s s r. s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t (ResultInfo s r -> ResultInfo s r)
-> BinTree (ResultInfo s r) -> BinTree (ResultInfo s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r)
rl) FailureInfo s
failure
rewindInput :: s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t (ResultInfo s
_ r
r) = s -> r -> ResultInfo s r
forall s r. s -> r -> ResultInfo s r
ResultInfo s
t r
r
instance TextualMonoid s => CharParsing (Parser g s) where
satisfy :: (Char -> Bool) -> Parser g s Char
satisfy Char -> Bool
predicate = (s -> ResultList s Char) -> Parser g s Char
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 s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
of Just (Char
first, s
rest) | Char -> Bool
predicate Char
first -> BinTree (ResultInfo s Char) -> FailureInfo s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a. a -> BinTree a
Leaf (ResultInfo s Char -> BinTree (ResultInfo s Char))
-> ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a b. (a -> b) -> a -> b
$ s -> Char -> ResultInfo s Char
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest Char
first) FailureInfo s
forall s. FailureInfo s
noFailure
Maybe (Char, s)
_ -> BinTree (ResultInfo s Char) -> FailureInfo s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s Char)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected String
"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)
fromResultList :: (Eq s, FactorialMonoid s) => s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList :: s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList s
s (ResultList BinTree (ResultInfo s r)
EmptyTree (FailureInfo Int
pos [Expected s]
msgs)) =
ParseFailure s -> ParseResults s [(s, r)]
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList s
_ (ResultList BinTree (ResultInfo s r)
rl FailureInfo s
_failure) = [(s, r)] -> ParseResults s [(s, r)]
forall a b. b -> Either a b
Right (ResultInfo s r -> (s, r)
forall a b. ResultInfo a b -> (a, b)
f (ResultInfo s r -> (s, r)) -> [ResultInfo s r] -> [(s, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r) -> [ResultInfo s r]
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)