{-# LANGUAGE CPP, FlexibleContexts, InstanceSigs, GeneralizedNewtypeDeriving,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
-- | A context-free, non-memoizing parser that handles all alternatives in parallel.
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)

-- | Parser type for context-free grammars using a parallel parsing algorithm with no result sharing nor left recursion
-- support.
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
(<>)

-- | Parallel parser produces a list of all possible parses.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, Eq s, 'FactorialMonoid' s) =>
--                  g (Parallel.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (Cancellative.LeftReductive s, FactorialMonoid s, Ord s) => MultiParsing (Parser g s) where
   type ResultFunctor (Parser g s) = Compose (ParseResults s) []
   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
   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
   -- | Returns the list of all possible parses of complete input.
   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)