{-# 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 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 qualified Text.Parser.Char
import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.LookAhead (LookAheadParsing(..))

import qualified Rank2

import Text.Grampa.Class (DeterministicParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),
                          ParseResults, ParseFailure(..), Expected(..))
import Text.Grampa.Internal (BinTree(..), FailureInfo(..), noFailure)

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 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 l :: BinTree (ResultInfo s r)
l f :: FailureInfo s
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 s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f ")")

instance Show s => 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 s
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 s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
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 s
failure) = BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList ((a -> b
f (a -> b) -> ResultInfo s a -> ResultInfo s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ResultInfo s a -> ResultInfo s b)
-> BinTree (ResultInfo s a) -> BinTree (ResultInfo s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s a)
l) FailureInfo s
failure

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

instance Monoid (ResultList s r) where
   mempty :: ResultList s r
mempty = BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s r)
forall a. Monoid a => a
mempty FailureInfo s
forall s. FailureInfo s
noFailure
   mappend :: ResultList s r -> ResultList s r -> ResultList s r
mappend = ResultList s r -> ResultList s r -> ResultList s r
forall a. Semigroup a => a -> a -> a
(<>)

instance Functor (Parser g s) where
   fmap :: (a -> b) -> Parser g s a -> Parser g s b
fmap 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 s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s a -> BinTree (ResultInfo s a)
forall a. a -> BinTree a
Leaf (ResultInfo s a -> BinTree (ResultInfo s a))
-> ResultInfo s a -> BinTree (ResultInfo s a)
forall a b. (a -> b) -> a -> b
$ s -> a -> ResultInfo s a
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest a
a) FailureInfo s
forall s. FailureInfo s
noFailure)
   Parser 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 s
failure -> BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo s
failure ResultList s b -> ResultList s b -> ResultList s b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo s (a -> b) -> ResultList s b)
-> BinTree (ResultInfo s (a -> b)) -> ResultList s b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s (a -> b) -> ResultList s b
continue BinTree (ResultInfo s (a -> b))
results
      continue :: ResultInfo s (a -> b) -> ResultList s b
continue (ResultInfo 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 s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList s a)
-> FailureInfo s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "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 s
failure -> BinTree (ResultInfo s b) -> FailureInfo s -> ResultList s b
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s b)
forall a. Monoid a => a
mempty FailureInfo s
failure ResultList s b -> ResultList s b -> ResultList s b
forall a. Semigroup a => a -> a -> a
<> (ResultInfo s a -> ResultList s b)
-> BinTree (ResultInfo s a) -> ResultList s b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s a -> ResultList s b
continue BinTree (ResultInfo s a)
results
      continue :: ResultInfo s a -> ResultList s b
continue (ResultInfo 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, Eq s, 'FactorialMonoid' s) =>
--                  g (Parallel.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])
-- @
instance (Cancellative.LeftReductive s, FactorialMonoid 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 :: g (Parser g s)
g input :: s
input = (forall a.
 Parser g s a -> Compose (Compose (ParseResults s) []) ((,) s) a)
-> g (Parser g s)
-> g (Compose (Compose (ParseResults s) []) ((,) s))
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Compose (Either (ParseFailure s)) [] (s, a)
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Compose (Either (ParseFailure s)) [] (s, a)
 -> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a)
-> (Parser g s a -> Compose (Either (ParseFailure s)) [] (s, a))
-> Parser g s a
-> Compose (Compose (Either (ParseFailure s)) []) ((,) s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseFailure s) [(s, a)]
-> Compose (Either (ParseFailure s)) [] (s, a)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (ParseFailure s) [(s, a)]
 -> Compose (Either (ParseFailure s)) [] (s, a))
-> (Parser g s a -> Either (ParseFailure s) [(s, a)])
-> Parser g s a
-> Compose (Either (ParseFailure s)) [] (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ResultList s a -> Either (ParseFailure s) [(s, a)]
forall s r.
(Eq s, FactorialMonoid s) =>
s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList s
input (ResultList s a -> Either (ParseFailure s) [(s, a)])
-> (Parser g s a -> ResultList s a)
-> Parser g s a
-> Either (ParseFailure s) [(s, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser g s a -> s -> ResultList s a
forall (g :: (* -> *) -> *) s r.
Parser g s r -> s -> ResultList s r
`applyParser` s
input)) g (Parser g s)
g
   -- | 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 :: g' (Parser g s)
g input :: s
input = (forall a.
 Compose (ResultFunctor (Parser g s)) ((,) s) a
 -> Compose (ParseResults s) [] a)
-> g' (Compose (ResultFunctor (Parser g s)) ((,) s))
-> g' (Compose (ParseResults s) [])
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (((s, a) -> a
forall a b. (a, b) -> b
snd ((s, a) -> a)
-> Compose (ParseResults s) [] (s, a)
-> Compose (ParseResults s) [] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Compose (ParseResults s) [] (s, a)
 -> Compose (ParseResults s) [] a)
-> (Compose (Compose (ParseResults s) []) ((,) s) a
    -> Compose (ParseResults s) [] (s, a))
-> Compose (Compose (ParseResults s) []) ((,) s) a
-> Compose (ParseResults s) [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Compose (ParseResults s) []) ((,) s) a
-> Compose (ParseResults s) [] (s, a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (g' (Parser g s)
-> s -> g' (Compose (ResultFunctor (Parser g s)) ((,) s))
forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
 FactorialMonoid s) =>
g m -> s -> g (Compose (ResultFunctor m) ((,) s))
parsePrefix ((forall a. Parser g s a -> Parser g s a)
-> g' (Parser g s) -> g' (Parser g s)
forall k (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (Parser g s a -> Parser g s () -> Parser g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser g s ()
forall (m :: * -> *). Parsing m => m ()
eof) g' (Parser g s)
g) s
input)

instance (Cancellative.LeftReductive s, FactorialMonoid s) => InputParsing (Parser g s) where
   type ParserInput (Parser g s) = s
   getInput :: Parser g s (ParserInput (Parser g s))
getInput = (s -> ResultList s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
forall r. r -> ResultList r r
p
      where p :: r -> ResultList r r
p s :: r
s = BinTree (ResultInfo r r) -> FailureInfo r -> ResultList r r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo r r -> BinTree (ResultInfo r r)
forall a. a -> BinTree a
Leaf (ResultInfo r r -> BinTree (ResultInfo r r))
-> ResultInfo r r -> BinTree (ResultInfo r r)
forall a b. (a -> b) -> a -> b
$ r -> r -> ResultInfo r r
forall s r. s -> r -> ResultInfo s r
ResultInfo r
s r
s) FailureInfo r
forall s. FailureInfo s
noFailure
   anyToken :: Parser g s (ParserInput (Parser g s))
anyToken = (s -> ResultList s s) -> Parser g s s
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s s
forall m. FactorialMonoid m => m -> ResultList m m
p
      where p :: m -> ResultList m m
p 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 m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m m -> BinTree (ResultInfo m m)
forall a. a -> BinTree a
Leaf (ResultInfo m m -> BinTree (ResultInfo m m))
-> ResultInfo m m -> BinTree (ResultInfo m m)
forall a b. (a -> b) -> a -> b
$ m -> m -> ResultInfo m m
forall s r. s -> r -> ResultInfo s r
ResultInfo m
rest m
first) FailureInfo m
forall s. FailureInfo s
noFailure
                     _ -> BinTree (ResultInfo m m) -> FailureInfo m -> ResultList m m
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m m)
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) [String -> Expected m
forall s. String -> Expected s
Expected "anyToken"])
   satisfy :: (ParserInput (Parser g s) -> Bool)
-> Parser g s (ParserInput (Parser g s))
satisfy predicate :: 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 = 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) | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest s
first) FailureInfo s
forall s. FailureInfo s
noFailure
                     _ -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "satisfy"])
   notSatisfy :: (ParserInput (Parser g s) -> Bool) -> Parser g s ()
notSatisfy predicate :: 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
s = case s -> Maybe (s, s)
forall m. FactorialMonoid m => m -> Maybe (m, m)
Factorial.splitPrimePrefix s
s
                  of Just (first :: s
first, _) 
                        | ParserInput (Parser g s) -> Bool
predicate s
ParserInput (Parser g s)
first -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfy"])
                     _ -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo s
forall s. FailureInfo s
noFailure
   scan :: state
-> (state -> ParserInput (Parser g s) -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scan s0 :: state
s0 f :: 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 s :: state
s i :: s
i = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
               where (prefix :: s
prefix, suffix :: s
suffix, _) = 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 n :: 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
prefix, suffix :: s
suffix) <- Int -> s -> (s, s)
forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n s
s,
                s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
prefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
              | Bool
otherwise = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected (String -> Expected s) -> String -> Expected s
forall a b. (a -> b) -> a -> b
$ "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 predicate :: 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 = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
              where (prefix :: s
prefix, suffix :: 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 predicate :: 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
prefix, suffix :: s
suffix) <- (s -> Bool) -> s -> (s, s)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span s -> Bool
ParserInput (Parser g s) -> Bool
predicate s
s = 
               if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
prefix
               then BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "takeWhile1"])
               else BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
   string :: ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
string s :: 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
s' | Just suffix :: s
suffix <- s -> s -> Maybe s
forall m. LeftReductive m => m -> m -> Maybe m
Cancellative.stripPrefix s
ParserInput (Parser g s)
s s
s' = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
ParserInput (Parser g s)
s) FailureInfo s
forall s. FailureInfo s
noFailure
           | Bool
otherwise = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s') [s -> Expected s
forall s. s -> Expected s
ExpectedInput s
ParserInput (Parser g s)
s])

instance TextualMonoid s => InputCharParsing (Parser g s) where
   satisfyCharInput :: (Char -> Bool) -> Parser g s (ParserInput (Parser g 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 s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest (s -> ResultInfo s s) -> s -> ResultInfo s s
forall a b. (a -> b) -> a -> b
$ s -> s
forall m. Factorial m => m -> m
Factorial.primePrefix s
s) FailureInfo s
forall s. FailureInfo s
noFailure
                  _ -> BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "satisfyCharInput"])
   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 s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s ())
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "notSatisfyChar"])
                     _ -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
s ()) FailureInfo s
forall s. FailureInfo s
noFailure
   scanChars :: state
-> (state -> Char -> Maybe state)
-> Parser g s (ParserInput (Parser g s))
scanChars s0 :: state
s0 f :: 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 s :: state
s i :: s
i = BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
               where (prefix :: s
prefix, suffix :: s
suffix, _) = 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 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 s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure
   takeCharsWhile1 :: (Char -> Bool) -> Parser g s (ParserInput (Parser g s))
takeCharsWhile1 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 s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s s)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "takeCharsWhile1"])
               else BinTree (ResultInfo s s) -> FailureInfo s -> ResultList s s
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s s -> BinTree (ResultInfo s s)
forall a. a -> BinTree a
Leaf (ResultInfo s s -> BinTree (ResultInfo s s))
-> ResultInfo s s -> BinTree (ResultInfo s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> ResultInfo s s
forall s r. s -> r -> ResultInfo s r
ResultInfo s
suffix s
prefix) FailureInfo s
forall s. FailureInfo s
noFailure

instance FactorialMonoid s => Parsing (Parser g s) where
   try :: Parser g s a -> Parser g s a
try (Parser 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 :: [Expected s]
_msgs)) =
                        BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
rl (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest) [])
   Parser 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 :: [Expected s]
msgs)) =
                        BinTree (ResultInfo s a) -> FailureInfo s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. BinTree a
EmptyTree (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos ([Expected s] -> FailureInfo s) -> [Expected s] -> FailureInfo s
forall a b. (a -> b) -> a -> b
$
                                              if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
rest then [String -> Expected s
forall s. String -> Expected s
Expected String
msg] else [Expected s]
msgs)
                     replaceFailure 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 m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
t ()) FailureInfo m
forall s. FailureInfo s
noFailure
            rewind t :: m
t ResultList{} = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
t) [String -> Expected m
forall s. String -> Expected s
Expected "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 -> 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 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 s -> ResultList s a
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s a)
forall a. Monoid a => a
mempty (FailureInfo s -> ResultList s a)
-> FailureInfo s -> ResultList s a
forall a b. (a -> b) -> a -> b
$ Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
t) [String -> Expected s
forall s. String -> Expected s
Expected String
msg])
   eof :: Parser g s ()
eof = (s -> ResultList s ()) -> Parser g s ()
forall (g :: (* -> *) -> *) s r.
(s -> ResultList s r) -> Parser g s r
Parser s -> ResultList s ()
forall m. (MonoidNull m, Factorial m) => m -> ResultList m ()
f
      where f :: m -> ResultList m ()
f s :: m
s | m -> Bool
forall m. MonoidNull m => m -> Bool
null m
s = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo m () -> BinTree (ResultInfo m ())
forall a. a -> BinTree a
Leaf (ResultInfo m () -> BinTree (ResultInfo m ()))
-> ResultInfo m () -> BinTree (ResultInfo m ())
forall a b. (a -> b) -> a -> b
$ m -> () -> ResultInfo m ()
forall s r. s -> r -> ResultInfo s r
ResultInfo m
s ()) FailureInfo m
forall s. FailureInfo s
noFailure
                | Bool
otherwise = BinTree (ResultInfo m ()) -> FailureInfo m -> ResultList m ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo m ())
forall a. Monoid a => a
mempty (Int -> [Expected m] -> FailureInfo m
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (m -> Int
forall m. Factorial m => m -> Int
Factorial.length m
s) [String -> Expected m
forall s. String -> Expected s
Expected "end of input"])

instance FactorialMonoid s => DeterministicParsing (Parser g s) where
   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 = case s -> ResultList s a
p s
rest
               of rl :: ResultList s a
rl@(ResultList EmptyTree _failure :: FailureInfo s
_failure) -> ResultList s a
rl ResultList s a -> ResultList s a -> ResultList s a
forall a. Semigroup a => a -> a -> a
<> s -> ResultList s a
q s
rest
                  rl :: ResultList s a
rl -> ResultList s a
rl
   takeSome :: Parser g s a -> Parser g s [a]
takeSome p :: 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 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 (([a] -> [a]) -> s -> ResultList s [a]
q [a] -> [a]
forall a. a -> a
id) where
      q :: ([a] -> [a]) -> s -> ResultList s [a]
q acc :: [a] -> [a]
acc rest :: s
rest = case s -> ResultList s a
p s
rest
                   of ResultList EmptyTree _failure :: FailureInfo s
_failure -> BinTree (ResultInfo s [a]) -> FailureInfo s -> ResultList s [a]
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s [a] -> BinTree (ResultInfo s [a])
forall a. a -> BinTree a
Leaf (ResultInfo s [a] -> BinTree (ResultInfo s [a]))
-> ResultInfo s [a] -> BinTree (ResultInfo s [a])
forall a b. (a -> b) -> a -> b
$ s -> [a] -> ResultInfo s [a]
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ([a] -> [a]
acc [])) FailureInfo s
forall a. Monoid a => a
mempty
                      ResultList rl :: BinTree (ResultInfo s a)
rl _ -> (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 rest' :: s
rest' result :: 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 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 s -> ResultList s ()
q where
      q :: s -> ResultList s ()
q rest :: s
rest = case s -> ResultList s a
p s
rest
               of ResultList EmptyTree _failure :: FailureInfo s
_failure -> BinTree (ResultInfo s ()) -> FailureInfo s -> ResultList s ()
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s () -> BinTree (ResultInfo s ())
forall a. a -> BinTree a
Leaf (ResultInfo s () -> BinTree (ResultInfo s ()))
-> ResultInfo s () -> BinTree (ResultInfo s ())
forall a b. (a -> b) -> a -> b
$ s -> () -> ResultInfo s ()
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest ()) FailureInfo s
forall a. Monoid a => a
mempty
                  ResultList rl :: BinTree (ResultInfo s a)
rl _failure :: FailureInfo s
_failure -> (ResultInfo s a -> ResultList s ())
-> BinTree (ResultInfo s a) -> ResultList s ()
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ResultInfo s a -> ResultList s ()
continue BinTree (ResultInfo s a)
rl
         where continue :: ResultInfo s a -> ResultList s ()
continue (ResultInfo rest' :: s
rest' _) = s -> ResultList s ()
q s
rest'

instance FactorialMonoid s => LookAheadParsing (Parser g s) where
   lookAhead :: Parser g s a -> Parser g s a
lookAhead (Parser 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 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 s
failure) = BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (s -> ResultInfo s r -> ResultInfo s r
forall s s r. s -> ResultInfo s r -> ResultInfo s r
rewindInput s
t (ResultInfo s r -> ResultInfo s r)
-> BinTree (ResultInfo s r) -> BinTree (ResultInfo s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r)
rl) FailureInfo s
failure
            rewindInput :: s -> ResultInfo s r -> ResultInfo s r
rewindInput 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 TextualMonoid s => CharParsing (Parser g s) where
   satisfy :: (Char -> Bool) -> Parser g s Char
satisfy 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 s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList (ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a. a -> BinTree a
Leaf (ResultInfo s Char -> BinTree (ResultInfo s Char))
-> ResultInfo s Char -> BinTree (ResultInfo s Char)
forall a b. (a -> b) -> a -> b
$ s -> Char -> ResultInfo s Char
forall s r. s -> r -> ResultInfo s r
ResultInfo s
rest Char
first) FailureInfo s
forall s. FailureInfo s
noFailure
                  _ -> BinTree (ResultInfo s Char) -> FailureInfo s -> ResultList s Char
forall s r.
BinTree (ResultInfo s r) -> FailureInfo s -> ResultList s r
ResultList BinTree (ResultInfo s Char)
forall a. Monoid a => a
mempty (Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) [String -> Expected s
forall s. String -> Expected s
Expected "Char.satisfy"])
   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
<$> 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 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
<$> ParserInput (Parser g s) -> Parser g s (ParserInput (Parser g s))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string (Text -> s
forall t. TextualMonoid t => Text -> t
Textual.fromText Text
t)

fromResultList :: (Eq s, FactorialMonoid s) => s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList :: s -> ResultList s r -> ParseResults s [(s, r)]
fromResultList s :: s
s (ResultList EmptyTree (FailureInfo pos :: Int
pos msgs :: [Expected s]
msgs)) = 
   ParseFailure s -> ParseResults s [(s, r)]
forall a b. a -> Either a b
Left (Int -> [Expected s] -> ParseFailure s
forall s. Int -> [Expected s] -> ParseFailure s
ParseFailure (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList _ (ResultList rl :: BinTree (ResultInfo s r)
rl _failure :: FailureInfo s
_failure) = [(s, r)] -> ParseResults s [(s, r)]
forall a b. b -> Either a b
Right (ResultInfo s r -> (s, r)
forall a b. ResultInfo a b -> (a, b)
f (ResultInfo s r -> (s, r)) -> [ResultInfo s r] -> [(s, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree (ResultInfo s r) -> [ResultInfo s r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList BinTree (ResultInfo s r)
rl)
   where f :: ResultInfo a b -> (a, b)
f (ResultInfo s :: a
s r :: b
r) = (a
s, b
r)