{-# LANGUAGE FlexibleContexts, InstanceSigs, GeneralizedNewtypeDeriving,
             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
module Text.Grampa.ContextFree.Parallel (FailureInfo(..), ResultList(..), Parser, fromResultList)
where

import Control.Applicative
import Control.Monad (Monad(..), MonadPlus(..))
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.List (nub)
import Data.Semigroup (Semigroup(..))
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.Cancellative as Cancellative
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 qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.LookAhead (LookAheadParsing(..))
import Text.Parser.Token (TokenParsing)
import qualified Text.Parser.Token

import qualified Rank2

import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
import Text.Grampa.Internal (BinTree(..))

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 :: (* -> *) -> *) s r = Parser{Parser g s r -> s -> ResultList s r
applyParser :: s -> ResultList s r}

data ResultList s r = ResultList !(BinTree (ResultInfo s r)) {-# UNPACK #-} !FailureInfo
data ResultInfo s r = ResultInfo !s !r
data FailureInfo = FailureInfo Int [String] deriving (FailureInfo -> FailureInfo -> Bool
(FailureInfo -> FailureInfo -> Bool)
-> (FailureInfo -> FailureInfo -> Bool) -> Eq FailureInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureInfo -> FailureInfo -> Bool
$c/= :: FailureInfo -> FailureInfo -> Bool
== :: FailureInfo -> FailureInfo -> Bool
$c== :: FailureInfo -> FailureInfo -> Bool
Eq, Int -> FailureInfo -> ShowS
[FailureInfo] -> ShowS
FailureInfo -> String
(Int -> FailureInfo -> ShowS)
-> (FailureInfo -> String)
-> ([FailureInfo] -> ShowS)
-> Show FailureInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureInfo] -> ShowS
$cshowList :: [FailureInfo] -> ShowS
show :: FailureInfo -> String
$cshow :: FailureInfo -> String
showsPrec :: Int -> FailureInfo -> ShowS
$cshowsPrec :: Int -> FailureInfo -> ShowS
Show)

instance (Show s, Show r) => Show (ResultList s r) where
   show :: ResultList s r -> String
show (ResultList l :: BinTree (ResultInfo s r)
l f :: FailureInfo
f) = "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 -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo
f ")")

instance Show1 (ResultList s) where
   liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList s a -> ShowS
liftShowsPrec _sp :: Int -> a -> ShowS
_sp showList :: [a] -> ShowS
showList _prec :: Int
_prec (ResultList l :: BinTree (ResultInfo s a)
l f :: FailureInfo
f) rest :: String
rest = "ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> ShowS
showList (ResultInfo s a -> a
forall s r. ResultInfo s r -> r
simplify (ResultInfo s a -> a) -> [ResultInfo s a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a) -> [ResultInfo s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s a)
l) (FailureInfo -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo
f String
rest)
      where simplify :: ResultInfo s r -> r
simplify (ResultInfo _ r :: r
r) = r
r

instance (Show s, Show r) => Show (ResultInfo s r) where
   show :: ResultInfo s r -> String
show (ResultInfo s :: s
s r :: r
r) = "(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 -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> ShowS
forall a. Show a => a -> ShowS
shows r
r ")"

instance Functor (ResultInfo s) where
   fmap :: (a -> b) -> ResultInfo s a -> ResultInfo s b
fmap f :: a -> b
f (ResultInfo s :: s
s r :: a
r) = s -> b -> ResultInfo s b
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s (a -> b
f a
r)

instance Functor (ResultList s) where
   fmap :: (a -> b) -> ResultList s a -> ResultList s b
fmap f :: a -> b
f (ResultList l :: BinTree (ResultInfo s a)
l failure :: FailureInfo
failure) = BinTree (ResultInfo s b) -> FailureInfo -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList ((a -> b
f (a -> b) -> ResultInfo s a -> ResultInfo s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo s a -> ResultInfo s b)
-> BinTree (ResultInfo s a) -> BinTree (ResultInfo s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
l) FailureInfo
failure

instance Semigroup (ResultList s r) where
   ResultList rl1 :: BinTree (ResultInfo s r)
rl1 f1 :: FailureInfo
f1 <> :: ResultList s r -> ResultList s r -> ResultList s r
<> ResultList rl2 :: BinTree (ResultInfo s r)
rl2 f2 :: FailureInfo
f2 = BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (BinTree (ResultInfo s r)
rl1 BinTree (ResultInfo s r)
-> BinTree (ResultInfo s r) -> BinTree (ResultInfo s r)
forall a. Semigroup a => a -> a -> a
<> BinTree (ResultInfo s r)
rl2) (FailureInfo
f1 FailureInfo -> FailureInfo -> FailureInfo
forall a. Semigroup a => a -> a -> a
<> FailureInfo
f2)

instance Monoid (ResultList s r) where
   mempty :: ResultList s r
mempty = BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s r)
forall a. Monoid a => a
mempty FailureInfo
forall a. Monoid a => a
mempty
   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 Semigroup FailureInfo where
   FailureInfo pos1 :: Int
pos1 exp1 :: [String]
exp1 <> :: FailureInfo -> FailureInfo -> FailureInfo
<> FailureInfo pos2 :: Int
pos2 exp2 :: [String]
exp2 = Int -> [String] -> FailureInfo
FailureInfo Int
pos' [String]
exp'
      where (pos' :: Int
pos', exp' :: [String]
exp') | Int
pos1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pos2 = (Int
pos1, [String]
exp1)
                         | Int
pos1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pos2 = (Int
pos2, [String]
exp2)
                         | Bool
otherwise = (Int
pos1, [String]
exp1 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
exp2)

instance Monoid FailureInfo where
   mempty :: FailureInfo
mempty = Int -> [String] -> FailureInfo
FailureInfo Int
forall a. Bounded a => a
maxBound []
   mappend :: FailureInfo -> FailureInfo -> FailureInfo
mappend = FailureInfo -> FailureInfo -> FailureInfo
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 f :: a -> b
f (Parser p :: s -> ResultList s a
p) = (s -> ResultList s b) -> Parser g s b
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser ((a -> b) -> ResultList s a -> ResultList s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ResultList s a -> ResultList s b)
-> (s -> ResultList s a) -> s -> ResultList s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a
p)

instance Applicative (Parser g s) where
   pure :: a -> Parser g s a
pure a :: a
a = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\rest :: s
rest-> BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s a -> BinTree (ResultInfo s a)
forall a. a -> BinTree a
Leaf (ResultInfo s a -> BinTree (ResultInfo s a))
-> ResultInfo s a -> BinTree (ResultInfo s a)
forall a b. (a -> b) -> a -> b
$ s -> a -> ResultInfo s a
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest a
a) FailureInfo
forall a. Monoid a => a
mempty)
   Parser p :: s -> ResultList s (a -> b)
p <*> :: Parser g s (a -> b) -> Parser g s a -> Parser g s b
<*> Parser q :: 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 rest :: s
rest = case s -> ResultList s (a -> b)
p s
rest
               of ResultList results :: BinTree (ResultInfo s (a -> b))
results failure :: FailureInfo
failure -> BinTree (ResultInfo s b) -> FailureInfo -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo
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 rest' :: s
rest' f :: a -> b
f) = a -> b
f (a -> b) -> ResultList s a -> ResultList s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> ResultList s a
q s
rest'


instance FactorialMonoid s => Alternative (Parser g s) where
   empty :: Parser g s a
empty = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\s :: s
s-> BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo -> ResultList s a) -> FailureInfo -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["empty"])
   Parser p :: s -> ResultList s a
p <|> :: Parser g s a -> Parser g s a -> Parser g s a
<|> Parser q :: 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 rest :: 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 Monad (Parser g s) where
   return :: a -> Parser g s a
return = a -> Parser g s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Parser p :: s -> ResultList s a
p >>= :: Parser g s a -> (a -> Parser g s b) -> Parser g s b
>>= f :: 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 rest :: s
rest = case s -> ResultList s a
p s
rest
               of ResultList results :: BinTree (ResultInfo s a)
results failure :: FailureInfo
failure -> BinTree (ResultInfo s b) -> FailureInfo -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo
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 rest' :: s
rest' a :: a
a) = Parser g s b -> s -> ResultList s b
forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
applyParser (a -> Parser g s b
f a
a) s
rest'

instance FactorialMonoid s => MonadPlus (Parser g s) where
   mzero :: Parser g s a
mzero = Parser g s a
forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: Parser g s a -> Parser g s a -> Parser g s a
mplus = Parser g s a -> Parser g s a -> Parser g s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Semigroup x => Semigroup (Parser g s x) where
   <> :: Parser g s x -> Parser g s x -> Parser g s x
(<>) = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid x => Monoid (Parser g s x) where
   mempty :: Parser g s x
mempty = x -> Parser g s x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty
   mappend :: Parser g s x -> Parser g s x -> Parser g s x
mappend = (x -> x -> x) -> Parser g s x -> Parser g s x -> Parser g s x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> x -> x
forall a. Monoid a => a -> a -> a
mappend

-- | Parallel parser produces a list of all possible parses.
--
-- @
-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
--                  g (Parallel.'Parser' g s) -> s -> g ('Compose' 'ParseResults' [])
-- @
instance MultiParsing Parser where
   type ResultFunctor Parser = Compose ParseResults []
   -- | 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) ((,) s))
parsePrefix g :: g (Parser g s)
g input :: s
input = (forall a.
 Parser g s a -> Compose (Compose ParseResults []) ((,) s) a)
-> g (Parser g s) -> g (Compose (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 (Compose ParseResults [] (s, a)
-> Compose (Compose ParseResults []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose ParseResults [] (s, a)
 -> Compose (Compose ParseResults []) ((,) s) a)
-> (Parser g s a -> Compose ParseResults [] (s, a))
-> Parser g s a
-> Compose (Compose ParseResults []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either ParseFailure [(s, a)] -> Compose ParseResults [] (s, a))
-> (Parser g s a -> Either ParseFailure [(s, a)])
-> Parser g s a
-> Compose ParseResults [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a -> Either ParseFailure [(s, a)]
forall s r.
FactorialMonoid s =>
s -> ResultList s r -> ParseResults [(s, r)]
fromResultList s
input (ResultList s a -> Either ParseFailure [(s, a)])
-> (Parser g s a -> ResultList s a)
-> Parser g s a
-> Either ParseFailure [(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 :: forall g s. (Rank2.Functor g, FactorialMonoid s) =>
                    g (Parser g s) -> s -> g (Compose ParseResults [])
   parseComplete :: g (Parser g s) -> s -> g (Compose ParseResults [])
parseComplete g :: g (Parser g s)
g input :: s
input = (forall a.
 Compose (ResultFunctor Parser) ((,) s) a
 -> Compose ParseResults [] a)
-> g (Compose (ResultFunctor Parser) ((,) s))
-> g (Compose ParseResults [])
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, a) -> Compose ParseResults [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose ParseResults [] (s, a) -> Compose ParseResults [] a)
-> (Compose (Compose ParseResults []) ((,) s) a
    -> Compose ParseResults [] (s, a))
-> Compose (Compose ParseResults []) ((,) s) a
-> Compose ParseResults [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Compose ParseResults []) ((,) s) a
-> Compose ParseResults [] (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) ((,) s))
forall (m :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *)
       s.
(MultiParsing m, GrammarConstraint m g, FactorialMonoid s) =>
g (m g s) -> 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 :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput) g (Parser g s)
g) s
input)

instance MonoidParsing (Parser g) where
   endOfInput :: Parser g s ()
endOfInput = (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 s :: m
s | m -> Bool
forall m. MonoidNull m => m -> Bool
null m
s = BinTree (ResultInfo m ()) -> FailureInfo -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
s ()) FailureInfo
forall a. Monoid a => a
mempty
                | Bool
otherwise = BinTree (ResultInfo m ()) -> FailureInfo -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) ["endOfInput"])
   getInput :: Parser g s 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 s :: r
s = BinTree (ResultInfo r r) -> FailureInfo -> ResultList r r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo r r -> BinTree (ResultInfo r r)
forall a. a -> BinTree a
Leaf (ResultInfo r r -> BinTree (ResultInfo r r))
-> ResultInfo r r -> BinTree (ResultInfo r r)
forall a b. (a -> b) -> a -> b
$ r -> r -> ResultInfo r r
forall s r. s -> r -> ResultInfo s r
ResultInfo r
s r
s) FailureInfo
forall a. Monoid a => a
mempty
   anyToken :: Parser g s 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 s :: m
s = case m -> Maybe (m, m)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix m
s
                  of Just (first :: m
first, rest :: m
rest) -> BinTree (ResultInfo m m) -> FailureInfo -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo m m -> BinTree (ResultInfo m m)
forall a. a -> BinTree a
Leaf (ResultInfo m m -> BinTree (ResultInfo m m))
-> ResultInfo m m -> BinTree (ResultInfo m m)
forall a b. (a -> b) -> a -> b
$ m -> m -> ResultInfo m m
forall s r. s -> r -> ResultInfo s r
ResultInfo m
rest m
first) FailureInfo
forall a. Monoid a => a
mempty
                     _ -> BinTree (ResultInfo m m) -> FailureInfo -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo m m)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) ["anyToken"])
   satisfy :: (s -> Bool) -> Parser g s s
satisfy predicate :: 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 = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                  of Just (first :: s
first, rest :: s
rest) | s -> Bool
predicate s
first -> BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest s
first) FailureInfo
forall a. Monoid a => a
mempty
                     _ -> BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["satisfy"])
   satisfyChar :: (Char -> Bool) -> Parser g s Char
satisfyChar predicate :: 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
s =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
               of Just (first :: Char
first, rest :: s
rest) | Char -> Bool
predicate Char
first -> BinTree (ResultInfo s Char) -> FailureInfo -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a. a -> BinTree a
Leaf (ResultInfo s Char -> BinTree (ResultInfo s Char))
-> ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a b. (a -> b) -> a -> b
$ s -> Char -> ResultInfo s Char
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest Char
first) FailureInfo
forall a. Monoid a => a
mempty
                  _ -> BinTree (ResultInfo s Char) -> FailureInfo -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s Char)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["satisfyChar"])
   satisfyCharInput :: (Char -> Bool) -> Parser g s s
satisfyCharInput predicate :: 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 =
               case s -> Maybe (Char, s)
forall t. TextualMonoid t => t -> Maybe (Char, t)
Textual.splitCharacterPrefix s
s
               of Just (first :: Char
first, rest :: s
rest) | Char -> Bool
predicate Char
first -> BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest (s -> ResultInfo s s) -> s -> ResultInfo s s
forall a b. (a -> b) -> a -> b
$ s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) FailureInfo
forall a. Monoid a => a
mempty
                  _ -> BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["satisfyChar"])
   notSatisfy :: (s -> Bool) -> Parser g s ()
notSatisfy predicate :: 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
s = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                  of Just (first :: s
first, _) 
                        | s -> Bool
predicate s
first -> BinTree (ResultInfo s ()) -> FailureInfo -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["notSatisfy"])
                     _ -> BinTree (ResultInfo s ()) -> FailureInfo -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo
forall a. Monoid a => a
mempty
   notSatisfyChar :: (Char -> Bool) -> Parser g s ()
notSatisfyChar predicate :: 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
s = case s -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
Textual.characterPrefix s
s
                  of Just first :: Char
first 
                        | Char -> Bool
predicate Char
first -> BinTree (ResultInfo s ()) -> FailureInfo -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["notSatisfyChar"])
                     _ -> BinTree (ResultInfo s ()) -> FailureInfo -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo
forall a. Monoid a => a
mempty
   scan :: s -> (s -> t -> Maybe s) -> Parser g t t
scan s0 :: s
s0 f :: s -> t -> Maybe s
f = (t -> ResultList t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (s -> t -> ResultList t t
p s
s0)
      where p :: s -> t -> ResultList t t
p s :: s
s i :: t
i = BinTree (ResultInfo t t) -> FailureInfo -> ResultList t t
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo t t -> BinTree (ResultInfo t t)
forall a. a -> BinTree a
Leaf (ResultInfo t t -> BinTree (ResultInfo t t))
-> ResultInfo t t -> BinTree (ResultInfo t t)
forall a b. (a -> b) -> a -> b
$ t -> t -> ResultInfo t t
forall s r. s -> r -> ResultInfo s r
ResultInfo t
suffix t
prefix) FailureInfo
forall a. Monoid a => a
mempty
               where (prefix :: t
prefix, suffix :: t
suffix, _) = s -> (s -> t -> Maybe s) -> t -> (t, t, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s s -> t -> Maybe s
f t
i
   scanChars :: s -> (s -> Char -> Maybe s) -> Parser g t t
scanChars s0 :: s
s0 f :: s -> Char -> Maybe s
f = (t -> ResultList t t) -> Parser g t t
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (s -> t -> ResultList t t
p s
s0)
      where p :: s -> t -> ResultList t t
p s :: s
s i :: t
i = BinTree (ResultInfo t t) -> FailureInfo -> ResultList t t
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo t t -> BinTree (ResultInfo t t)
forall a. a -> BinTree a
Leaf (ResultInfo t t -> BinTree (ResultInfo t t))
-> ResultInfo t t -> BinTree (ResultInfo t t)
forall a b. (a -> b) -> a -> b
$ t -> t -> ResultInfo t t
forall s r. s -> r -> ResultInfo s r
ResultInfo t
suffix t
prefix) FailureInfo
forall a. Monoid a => a
mempty
               where (prefix :: t
prefix, suffix :: t
suffix, _) = s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s s -> Char -> Maybe s
f t
i
   takeWhile :: (s -> Bool) -> Parser g s s
takeWhile predicate :: 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
prefix, suffix :: s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
predicate s
s = BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo
forall a. Monoid a => a
mempty
   takeWhile1 :: (s -> Bool) -> Parser g s s
takeWhile1 predicate :: 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
prefix, suffix :: s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
predicate s
s = 
               if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
               then BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["takeWhile1"])
               else BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo
forall a. Monoid a => a
mempty
   takeCharsWhile :: (Char -> Bool) -> Parser g s s
takeCharsWhile predicate :: 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
prefix, suffix :: s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s = 
               BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo
forall a. Monoid a => a
mempty
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s s
takeCharsWhile1 predicate :: 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
prefix, suffix :: s
suffix) <- Bool -> (Char -> Bool) -> s -> (s, s)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
False Char -> Bool
predicate s
s =
               if s -> Bool
forall m. MonoidNull m => m -> Bool
null s
prefix
               then BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) ["takeCharsWhile1"])
               else BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo
forall a. Monoid a => a
mempty
   string :: s -> Parser g s s
string s :: 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
s' | Just suffix :: s
suffix <- s -> s -> Maybe s
forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix s
s s
s' = BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> 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
s) FailureInfo
forall a. Monoid a => a
mempty
           | Bool
otherwise = BinTree (ResultInfo s s) -> FailureInfo -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') ["string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s])
   concatMany :: Parser g s a -> Parser g s a
concatMany (Parser p :: 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
s = BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> 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
s a
forall a. Monoid a => a
mempty) FailureInfo
failure ResultList s a -> ResultList s a -> ResultList s a
forall a. Semigroup a => a -> a -> a
<> (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)
rs
               where ResultList rs :: BinTree (ResultInfo s a)
rs failure :: FailureInfo
failure = s -> ResultList s a
p s
s
            continue :: ResultInfo s a -> ResultList s a
continue (ResultInfo suffix :: s
suffix prefix :: a
prefix) = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
prefix (a -> a) -> ResultList s a -> ResultList s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> ResultList s a
q s
suffix

instance FactorialMonoid s => Parsing (Parser g s) where
   try :: Parser g s a -> Parser g s a
try (Parser p :: 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 rest :: 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 rl :: BinTree (ResultInfo s a)
rl (FailureInfo _pos :: Int
_pos _msgs :: [String]
_msgs)) =
                        BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s a)
rl (Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [])
   Parser p :: s -> ResultList s a
p <?> :: Parser g s a -> String -> Parser g s a
<?> msg :: 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 rest :: 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 EmptyTree (FailureInfo pos :: Int
pos msgs :: [String]
msgs)) =
                        BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree (Int -> [String] -> FailureInfo
FailureInfo Int
pos ([String] -> FailureInfo) -> [String] -> FailureInfo
forall a b. (a -> b) -> a -> b
$
                                              if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest then [String
msg] else [String]
msgs)
                     replaceFailure rl :: ResultList s a
rl = ResultList s a
rl
   notFollowedBy :: Parser g s a -> Parser g s ()
notFollowedBy (Parser p :: s -> ResultList s a
p) = (s -> ResultList s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\input :: 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 t :: m
t (ResultList EmptyTree _) = BinTree (ResultInfo m ()) -> FailureInfo -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
t ()) FailureInfo
forall a. Monoid a => a
mempty
            rewind t :: m
t ResultList{} = BinTree (ResultInfo m ()) -> FailureInfo -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [String] -> FailureInfo
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
t) ["notFollowedBy"])
   skipMany :: Parser g s a -> Parser g s ()
skipMany p :: 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
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 msg :: String
msg = (s -> ResultList s a) -> Parser g s a
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser (\t :: s
t-> BinTree (ResultInfo s a) -> FailureInfo -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo -> ResultList s a) -> FailureInfo -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> FailureInfo
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String
msg])
   eof :: Parser g s ()
eof = Parser g s ()
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s ()
endOfInput

instance FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser p :: 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 (\input :: s
input-> s -> ResultList s a -> ResultList s a
forall s 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 t :: s
t (ResultList rl :: BinTree (ResultInfo s r)
rl failure :: FailureInfo
failure) = BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo -> ResultList s r
ResultList (s -> ResultInfo s r -> ResultInfo s r
forall s s r. s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t (ResultInfo s r -> ResultInfo s r)
-> BinTree (ResultInfo s r) -> BinTree (ResultInfo s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r)
rl) FailureInfo
failure
            rewindInput :: s -> ResultInfo s r -> ResultInfo s r
rewindInput t :: s
t (ResultInfo _ r :: r
r) = s -> r -> ResultInfo s r
forall s r. s -> r -> ResultInfo s r
ResultInfo s
t r
r

instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar
   string :: String -> Parser g s String
string s :: 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 "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
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (String -> s
forall a. IsString a => String -> a
fromString String
s)
   char :: Char -> Parser g s Char
char = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
   notChar :: Char -> Parser g s Char
notChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar ((Char -> Bool) -> Parser g s Char)
-> (Char -> Char -> Bool) -> Char -> Parser g s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
   anyChar :: Parser g s Char
anyChar = (Char -> Bool) -> Parser g s Char
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s Char
satisfyChar (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
   text :: Text -> Parser g s Text
text t :: 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 "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
<$> s -> Parser g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
   someSpace :: Parser g s ()
someSpace = Parser g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
someLexicalSpace
   semi :: Parser g s Char
semi = Parser g s Char
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
       s.
(Lexical g, LexicalConstraint m g s) =>
m g s Char
lexicalSemicolon
   token :: Parser g s a -> Parser g s a
token = Parser g s a -> Parser g s a
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
       a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken

fromResultList :: FactorialMonoid s => s -> ResultList s r -> ParseResults [(s, r)]
fromResultList :: s -> ResultList s r -> ParseResults [(s, r)]
fromResultList s :: s
s (ResultList EmptyTree (FailureInfo pos :: Int
pos msgs :: [String]
msgs)) = 
   ParseFailure -> ParseResults [(s, r)]
forall a b. a -> Either a b
Left (Int -> [String] -> ParseFailure
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
msgs))
fromResultList _ (ResultList rl :: BinTree (ResultInfo s r)
rl _failure :: FailureInfo
_failure) = [(s, r)] -> ParseResults [(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 s :: a
s r :: b
r) = (a
s, b
r)