{-# 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.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(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (BinTree(..), expected, 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{Parser g s r -> s -> ResultList s r
applyParser :: s -> ResultList s r}

data ResultList s r = ResultList !(BinTree (ResultInfo s r)) {-# UNPACK #-} !(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 Pos 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]
++ ParseFailure Pos s -> ShowS
forall a. Show a => a -> ShowS
shows ParseFailure Pos 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 ParseFailure Pos 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) (ParseFailure Pos s -> ShowS
forall a. Show a => a -> ShowS
shows ParseFailure Pos 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 ParseFailure Pos s
failure) = BinTree (ResultInfo s b) -> ParseFailure Pos s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos 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 ParseFailure Pos s
failure) = BinTree (ResultInfo s b) -> ParseFailure Pos s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
failure

instance Ord s => Semigroup (ResultList s r) where
   ResultList BinTree (ResultInfo s r)
rl1 ParseFailure Pos s
f1 <> :: ResultList s r -> ResultList s r -> ResultList s r
<> ResultList BinTree (ResultInfo s r)
rl2 ParseFailure Pos s
f2 = BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) (ParseFailure Pos s
f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)

instance Ord s => Monoid (ResultList s r) where
   mempty :: ResultList s r
mempty = BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s r)
forall a. Monoid a => a
mempty ParseFailure Pos s
forall s. ParseFailure Pos 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 Ord s => 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) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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 ParseFailure Pos s
failure -> BinTree (ResultInfo s b) -> ParseFailure Pos s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty ParseFailure Pos 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, Ord 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) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultList s a)
-> ParseFailure Pos s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [] [])
   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)

#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 :: 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 ParseFailure Pos s
failure -> BinTree (ResultInfo s b) -> ParseFailure Pos s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty ParseFailure Pos 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'

#if MIN_VERSION_base(4,13,0)
instance (FactorialMonoid s, Ord s) => MonadFail (Parser g s) where
#endif
   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) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (ParseFailure Pos s -> ResultList s a)
-> ParseFailure Pos s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg])

instance (FactorialMonoid s, Ord 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 (Ord s, 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, Ord s) => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
   mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = Parser g s x -> Parser g s x -> Parser g s x
forall a. Semigroup a => a -> a -> a
(<>)

-- | 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 :: 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 Pos s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure Pos s)) []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure Pos s)) [] (s, a)
 -> Compose (Compose (Either (ParseFailure Pos s)) []) ((,) s) a)
-> (Parser g s a
    -> Compose (Either (ParseFailure Pos s)) [] (s, a))
-> Parser g s a
-> Compose (Compose (Either (ParseFailure Pos s)) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure Pos s) [(s, a)]
-> Compose (Either (ParseFailure Pos s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure Pos s) [(s, a)]
 -> Compose (Either (ParseFailure Pos s)) [] (s, a))
-> (Parser g s a -> Either (ParseFailure Pos s) [(s, a)])
-> Parser g s a
-> Compose (Either (ParseFailure Pos s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultList s a -> Either (ParseFailure Pos s) [(s, a)]
forall s r.
(Eq s, FactorialMonoid s) =>
ResultList s r -> ParseResults s [(s, r)]
fromResultList (ResultList s a -> Either (ParseFailure Pos s) [(s, a)])
-> (Parser g s a -> ResultList s a)
-> Parser g s a
-> Either (ParseFailure Pos 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
   -- | 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 :: 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, Ord 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) -> ParseFailure Pos r -> ResultList r r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos r
forall s. ParseFailure Pos 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) -> ParseFailure Pos m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos m
forall s. ParseFailure Pos s
noFailure
                     Maybe (m, m)
_ -> BinTree (ResultInfo m m) -> ParseFailure Pos m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo m m)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos m
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ m -> Int
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 = (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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure
                     Maybe (s, s)
_ -> BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
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 = (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 ()) -> ParseFailure Pos s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfy")
                     Maybe (s, s)
_ -> BinTree (ResultInfo s ()) -> ParseFailure Pos s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 ()) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure
              | Bool
otherwise = BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) (String -> ParseFailure Pos s) -> String -> ParseFailure Pos s
forall a b. (a -> b) -> a -> b
$ String
"take " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
   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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"takeWhile1")
               else BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure
           | Bool
otherwise = BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') [s -> FailureDescription s
forall s. s -> FailureDescription s
LiteralDescription 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 ParseFailure Pos 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 (Ord s, 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure
                  Maybe (Char, s)
_ -> BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) 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 ()) -> ParseFailure Pos s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"notSatisfyChar")
                     Maybe Char
_ -> BinTree (ResultInfo s ()) -> ParseFailure Pos s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 ()) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos 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) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) String
"takeCharsWhile1")
               else BinTree (ResultInfo s s) -> ParseFailure Pos s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure

instance (FactorialMonoid s, Ord 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 ParseFailure Pos s
_) =
                        BinTree (ResultInfo s a) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
rl (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ 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 (ParseFailure Pos
pos [FailureDescription s]
msgs [FailureDescription s]
erroneous)) =
                        BinTree (ResultInfo s a) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree (Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure Pos
pos
                                                           (if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Pos
fromEnd (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest)
                                                            then [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription String
msg] else [FailureDescription s]
msgs)
                                                           [FailureDescription s]
erroneous)
                     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 ParseFailure Pos s
_) = BinTree (ResultInfo m ()) -> ParseFailure Pos m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 ()) ParseFailure Pos m
forall s. ParseFailure Pos s
noFailure
            rewind m
t ResultList{} = BinTree (ResultInfo m ()) -> ParseFailure Pos m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos m
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
t) 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) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty
                                 (ParseFailure Pos s -> ResultList s a)
-> ParseFailure Pos s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure Pos s
forall pos s.
pos
-> [FailureDescription s]
-> [FailureDescription s]
-> ParseFailure pos s
ParseFailure (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [] [String -> FailureDescription s
forall s. String -> FailureDescription s
StaticDescription 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 ()) -> ParseFailure Pos m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 ()) ParseFailure Pos m
forall s. ParseFailure Pos s
noFailure
                | Bool
otherwise = BinTree (ResultInfo m ()) -> ParseFailure Pos m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos m
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ m -> Int
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 <<|> :: 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 ParseFailure Pos 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 ParseFailure Pos s
_failure -> BinTree (ResultInfo s [a])
-> ParseFailure Pos s -> ResultList s [a]
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 [])) ParseFailure Pos s
forall a. Monoid a => a
mempty
                      ResultList BinTree (ResultInfo s a)
rl ParseFailure Pos 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 ParseFailure Pos s
_failure -> BinTree (ResultInfo s ()) -> ParseFailure Pos s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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 ()) ParseFailure Pos s
forall a. Monoid a => a
mempty
                  ResultList BinTree (ResultInfo s a)
rl ParseFailure Pos 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, Ord s) => CommittedParsing (Parser g s) where
   type CommittedResults (Parser g s) = ParseResults s
   commit :: Parser g s a -> Parser g s (CommittedResults (Parser g s) a)
commit (Parser s -> ResultList s a
p) = (s -> ResultList s (Either (ParseFailure Pos s) a))
-> Parser g s (Either (ParseFailure Pos s) a)
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s (Either (ParseFailure Pos s) a)
q
      where q :: s -> ResultList s (Either (ParseFailure Pos s) a)
q s
rest = case s -> ResultList s a
p s
rest
                     of ResultList BinTree (ResultInfo s a)
EmptyTree ParseFailure Pos s
failure -> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
-> ParseFailure Pos s
-> ResultList s (Either (ParseFailure Pos s) a)
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList (ResultInfo s (Either (ParseFailure Pos s) a)
-> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
forall a. a -> BinTree a
Leaf (ResultInfo s (Either (ParseFailure Pos s) a)
 -> BinTree (ResultInfo s (Either (ParseFailure Pos s) a)))
-> ResultInfo s (Either (ParseFailure Pos s) a)
-> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
forall a b. (a -> b) -> a -> b
$ s
-> Either (ParseFailure Pos s) a
-> ResultInfo s (Either (ParseFailure Pos s) a)
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest (Either (ParseFailure Pos s) a
 -> ResultInfo s (Either (ParseFailure Pos s) a))
-> Either (ParseFailure Pos s) a
-> ResultInfo s (Either (ParseFailure Pos s) a)
forall a b. (a -> b) -> a -> b
$ ParseFailure Pos s -> Either (ParseFailure Pos s) a
forall a b. a -> Either a b
Left ParseFailure Pos s
failure) ParseFailure Pos s
forall a. Monoid a => a
mempty
                        ResultList BinTree (ResultInfo s a)
rl ParseFailure Pos s
failure -> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
-> ParseFailure Pos s
-> ResultList s (Either (ParseFailure Pos s) a)
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList ((a -> Either (ParseFailure Pos s) a)
-> ResultInfo s a -> ResultInfo s (Either (ParseFailure Pos s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either (ParseFailure Pos s) a
forall a b. b -> Either a b
Right (ResultInfo s a -> ResultInfo s (Either (ParseFailure Pos s) a))
-> BinTree (ResultInfo s a)
-> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
rl) ParseFailure Pos s
failure
   admit :: Parser g s (CommittedResults (Parser g s) a) -> Parser g s a
admit (Parser s -> ResultList s (CommittedResults (Parser g 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 = case s -> ResultList s (CommittedResults (Parser g s) a)
p s
rest
                     of ResultList BinTree (ResultInfo s (CommittedResults (Parser g s) a))
EmptyTree ParseFailure Pos s
failure -> BinTree (ResultInfo s a) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree ParseFailure Pos s
failure
                        ResultList BinTree (ResultInfo s (CommittedResults (Parser g s) a))
rl ParseFailure Pos s
failure -> (ResultInfo s (Either (ParseFailure Pos s) a) -> ResultList s a)
-> BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
-> ResultList s a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s (Either (ParseFailure Pos s) a) -> ResultList s a
forall s r.
Ord s =>
ResultInfo s (Either (ParseFailure Pos s) r) -> ResultList s r
expose BinTree (ResultInfo s (Either (ParseFailure Pos s) a))
BinTree (ResultInfo s (CommittedResults (Parser g s) a))
rl ResultList s a -> ResultList s a -> ResultList s a
forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo s a) -> ParseFailure Pos s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree ParseFailure Pos s
failure
            expose :: ResultInfo s (Either (ParseFailure Pos s) r) -> ResultList s r
expose (ResultInfo s
_ (Left ParseFailure Pos s
failure)) = BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s r)
forall a. BinTree a
EmptyTree ParseFailure Pos s
failure
            expose (ResultInfo s
rest (Right r
r)) = BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList (ResultInfo s r -> BinTree (ResultInfo s r)
forall a. a -> BinTree a
Leaf (ResultInfo s r -> BinTree (ResultInfo s r))
-> ResultInfo s r -> BinTree (ResultInfo s r)
forall a b. (a -> b) -> a -> b
$ s -> r -> ResultInfo s r
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest r
r) ParseFailure Pos s
forall a. Monoid a => a
mempty

instance (FactorialMonoid s, Ord 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 ParseFailure Pos s
failure) = BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos 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, Ord 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)
-> ParseFailure Pos s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos 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) ParseFailure Pos s
forall s. ParseFailure Pos s
noFailure
                  Maybe (Char, s)
_ -> BinTree (ResultInfo s Char)
-> ParseFailure Pos s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> ParseFailure Pos s -> ResultList s r
ResultList BinTree (ResultInfo s Char)
forall a. Monoid a => a
mempty (Pos -> String -> ParseFailure Pos s
forall s. Pos -> String -> ParseFailure Pos s
expected (Int -> Pos
fromEnd (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) 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) => ResultList s r -> ParseResults s [(s, r)]
fromResultList :: ResultList s r -> ParseResults s [(s, r)]
fromResultList (ResultList BinTree (ResultInfo s r)
EmptyTree ParseFailure Pos s
failure) = ParseFailure Pos s -> ParseResults s [(s, r)]
forall a b. a -> Either a b
Left ParseFailure Pos s
failure
fromResultList (ResultList BinTree (ResultInfo s r)
rl ParseFailure Pos 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)