grammatical-parsers 0.2 → 0.2.1

raw patch · 10 files changed

+1164/−213 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• grammatical-parsers.cabal +7/−4
• src/Text/Grampa/ContextFree/Continued.hs +230/−0
• src/Text/Grampa/ContextFree/Continued/Measured.hs +249/−0
• src/Text/Grampa/ContextFree/LeftRecursive.hs +2/−2
• src/Text/Grampa/ContextFree/Memoizing.hs +4/−4
• src/Text/Grampa/ContextFree/Parallel.hs +1/−1
• src/Text/Grampa/PEG/Backtrack/Length.hs +0/−202
• src/Text/Grampa/PEG/Backtrack/Measured.hs +202/−0
• src/Text/Grampa/PEG/Continued.hs +227/−0
• src/Text/Grampa/PEG/Continued/Measured.hs +242/−0

@@ -1,5 +1,5 @@ name:                grammatical-parsers-version:             0.2+version:             0.2.1 synopsis:            parsers that can combine into grammars description:   /Gram/matical-/pa/rsers, or Grampa for short, is a library of parser types whose values are meant to be assigned@@ -25,9 +25,12 @@   hs-source-dirs:      src   exposed-modules:     Text.Grampa,                        Text.Grampa.PEG.Backtrack, Text.Grampa.PEG.Packrat,-                       Text.Grampa.ContextFree.Parallel, Text.Grampa.ContextFree.Memoizing,-                       Text.Grampa.ContextFree.LeftRecursive-  other-modules:       Text.Grampa.Class, Text.Grampa.Internal, Text.Grampa.PEG.Backtrack.Length+                       Text.Grampa.ContextFree.Continued, Text.Grampa.ContextFree.Parallel,+                       Text.Grampa.ContextFree.Memoizing, Text.Grampa.ContextFree.LeftRecursive+  other-modules:       Text.Grampa.Class, Text.Grampa.Internal,+                       Text.Grampa.PEG.Backtrack.Measured,+                       Text.Grampa.PEG.Continued, Text.Grampa.PEG.Continued.Measured,+                       Text.Grampa.ContextFree.Continued.Measured   default-language:    Haskell2010   -- other-modules:   ghc-options:         -Wall

@@ -0,0 +1,230 @@+{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+-- | Continuation-passing parser for context-free grammars+module Text.Grampa.ContextFree.Continued (Parser(..), Result(..), alt) where++import Control.Applicative (Applicative(..), Alternative(..), liftA2)+import Control.Monad (Monad(..), MonadPlus(..))++import Data.Char (isSpace)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose (Compose(..))+import Data.List (nub)+import Data.Monoid (Monoid(mappend, mempty), (<>))+import Data.Monoid.Factorial(FactorialMonoid)+import Data.Monoid.Textual(TextualMonoid)+import Data.String (fromString)++import qualified Data.Monoid.Cancellative as Cancellative+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual++import qualified Rank2++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(someSpace))+import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))+import Text.Grampa.Internal (FailureInfo(..))++data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,+                                              parsedSuffix :: !s}+                                     | NoParse FailureInfo++-- | Parser type for context-free grammars that uses a continuation-passing algorithm, fast for grammars in LL(1)+-- class but with potentially exponential performance for longer ambiguous prefixes.+newtype Parser (g :: (* -> *) -> *) s r =+   Parser{applyParser :: forall x. s -> (r -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x}++instance Show1 (Result g s) where+   liftShowsPrec showsPrecSub _showList prec Parsed{parsedPrefix= r} rest = "Parsed " ++ showsPrecSub prec r rest+   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest++instance Functor (Result g s) where+   fmap f (Parsed a rest) = Parsed (f a) rest+   fmap _ (NoParse failure) = NoParse failure+   +instance Functor (Parser g s) where+   fmap f (Parser p) = Parser (\input success-> p input (success . f))+   {-# INLINABLE fmap #-}++instance Applicative (Parser g s) where+   pure a = Parser (\input success failure-> success a input failure)+   (<*>) :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b+   Parser p <*> Parser q = Parser r where+      r :: forall x. s -> (b -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\f rest'-> q rest' (success . f)) failure+   {-# INLINABLE (<*>) #-}++instance Factorial.FactorialMonoid s => Alternative (Parser g s) where+   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   (<|>) = alt++-- | A named and unconstrained version of the '<|>' operator+alt :: forall g s a. Parser g s a -> Parser g s a -> Parser g s a+Parser p `alt` Parser q = Parser r where+   r :: forall x. s -> (a -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+   r rest success failure = p rest success' failure'+      where success' a rest' _ = success a rest' failure'+            failure' f1 = q rest success (\f2 -> failure (f1 <> f2))++instance Monad (Parser g s) where+   return = pure+   (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b+   Parser p >>= f = Parser r where+      r :: forall x. s -> (b -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\a rest'-> applyParser (f a) rest' success) failure++instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where+   mzero = empty+   mplus = (<|>)++instance Monoid x => Monoid (Parser g s x) where+   mempty = pure mempty+   mappend = liftA2 mappend++instance Factorial.FactorialMonoid s => Parsing (Parser g s) where+   try = id+   (<?>) = const+   eof = endOfInput+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   notFollowedBy (Parser p) = Parser q+      where q :: forall x. s -> (() -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' _ _ _ = failure (FailureInfo 1 (fromIntegral $ Factorial.length input) ["notFollowedBy"])+                     failure' _ = success () input failure++instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where+   lookAhead :: forall a. Parser g s a -> Parser g s a+   lookAhead (Parser p) = Parser q+      where q :: forall x. s -> (a -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' a _ = success a input+                     failure' f = failure f++instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where+   satisfy = satisfyChar+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   char = satisfyChar . (==)+   notChar = satisfyChar . (/=)+   anyChar = satisfyChar (const True)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where+   someSpace = () <$ takeCharsWhile1 isSpace++instance MonoidParsing (Parser g) where+   endOfInput = Parser p+      where p rest success failure+               | Null.null rest = success () rest failure+               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+   getInput = Parser p+      where p rest success failure = success rest mempty failure+   anyToken = Parser p+      where p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) -> success first suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+   satisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   satisfy predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) | predicate first -> success first suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+   satisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s Char+   satisfyChar predicate = Parser p+      where p :: forall x. s -> (Char -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success first suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   satisfyCharInput :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   satisfyCharInput predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success (Factorial.primePrefix rest) suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   notSatisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s ()+   notSatisfy predicate = Parser p+      where p :: forall x. s -> (() -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, _)+                     | predicate first -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfy"])+                  _ -> success () rest failure+   notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()+   notSatisfyChar predicate = Parser p+      where p :: forall x. s -> (() -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.characterPrefix rest+               of Just first | predicate first+                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                  _ -> success () rest failure+   scan :: forall t s. FactorialMonoid t => s -> (s -> t -> Maybe s) -> Parser g t t+   scan s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> t -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p s rest success failure = success prefix suffix failure+               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest+   scanChars :: forall t s. TextualMonoid t => s -> (s -> Char -> Maybe s) -> Parser g t t+   scanChars s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> t -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p s rest success failure = success prefix suffix failure+               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest+   takeWhile :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure | (prefix, suffix) <- Factorial.span predicate rest = success prefix suffix failure+   takeWhile1 :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Factorial.span predicate rest =+                    if Null.null prefix+                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    else success prefix suffix failure+   takeCharsWhile :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Textual.span_ False predicate rest = success prefix suffix failure+   takeCharsWhile1 :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | Null.null prefix = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])+               | otherwise = success prefix suffix failure+               where (prefix, suffix) = Textual.span_ False predicate rest+   string :: forall s. (Cancellative.LeftReductiveMonoid s, FactorialMonoid s, Show s) => s -> Parser g s s+   string s = Parser p where+      p :: forall x. s -> (s -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      p s' success failure+         | Just suffix <- Cancellative.stripPrefix s s' = success s suffix failure+         | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+   whiteSpace = () <$ takeCharsWhile isSpace+   concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a+   concatMany (Parser p) = Parser q+      where q :: forall x. s -> (a -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q rest success failure = p rest success' (const $ success mempty rest failure)+               where success' prefix suffix failure' =+                        q suffix (success . (prefix <>)) (const $ success prefix suffix failure')+   {-# INLINABLE string #-}++-- | Continuation-passing context-free parser+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>+--                  g (Continued.'Parser' g s) -> s -> g 'ParseResults'+-- @+instance MultiParsing Parser where+   type ResultFunctor Parser = ParseResults+   -- | Returns an input prefix parse paired with the remaining input suffix.+   parsePrefix g input = Rank2.fmap (Compose . (\p-> applyParser p input (\a rest _-> Right (rest, a)) (Left . fromFailure input))) g+   parseComplete g input = Rank2.fmap (\p-> applyParser p input (const . const . Right) (Left . fromFailure input))+                                      (Rank2.fmap (<* endOfInput) g)++fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure+fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)

@@ -0,0 +1,249 @@+{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+-- | Continuation-passing parser for context-free grammars that keeps track of the parsed prefix length+module Text.Grampa.ContextFree.Continued.Measured (Parser(..), Result(..), alt) where++import Control.Applicative (Applicative(..), Alternative(..), liftA2)+import Control.Monad (Monad(..), MonadPlus(..))++import Data.Char (isSpace)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose (Compose(..))+import Data.List (nub)+import Data.Monoid (Monoid(mappend, mempty), (<>))+import Data.Monoid.Factorial(FactorialMonoid)+import Data.Monoid.Textual(TextualMonoid)+import Data.String (fromString)++import qualified Data.Monoid.Cancellative as Cancellative+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual++import qualified Rank2++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(someSpace))+import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))+import Text.Grampa.Internal (FailureInfo(..))++data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,+                                              parsedSuffix :: !s}+                                     | NoParse FailureInfo++-- | Parser type for context-free grammars that uses a continuation-passing algorithm, fast for grammars in LL(1)+-- class but with potentially exponential performance for longer ambiguous prefixes.+newtype Parser (g :: (* -> *) -> *) s r =+   Parser{applyParser :: forall x. s -> (r -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x}++instance Show1 (Result g s) where+   liftShowsPrec showsPrecSub _showList prec Parsed{parsedPrefix= r} rest = "Parsed " ++ showsPrecSub prec r rest+   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest++instance Functor (Result g s) where+   fmap f (Parsed a rest) = Parsed (f a) rest+   fmap _ (NoParse failure) = NoParse failure+   +instance Functor (Parser g s) where+   fmap f (Parser p) = Parser (\input success-> p input (success . f))+   {-# INLINABLE fmap #-}++instance Applicative (Parser g s) where+   pure a = Parser (\input success failure-> success a 0 input failure)+   (<*>) :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b+   Parser p <*> Parser q = Parser r where+      r :: forall x. s -> (b -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\f len rest'-> q rest' (\a len'-> success (f a) $! len + len')) failure+   {-# INLINABLE (<*>) #-}++instance Factorial.FactorialMonoid s => Alternative (Parser g s) where+   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   (<|>) = alt++-- | A named and unconstrained version of the '<|>' operator+alt :: forall g s a. Parser g s a -> Parser g s a -> Parser g s a+Parser p `alt` Parser q = Parser r where+   r :: forall x. s -> (a -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+   r rest success failure = p rest success' failure'+      where success' a len rest' _ = success a len rest' failure'+            failure' f1 = q rest success (\f2 -> failure (f1 <> f2))++instance Monad (Parser g s) where+   return = pure+   (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b+   Parser p >>= f = Parser r where+      r :: forall x. s -> (b -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest+                                 (\a len rest'-> applyParser (f a) rest' $ \b len'-> success b $! len + len')+                                 failure++instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where+   mzero = empty+   mplus = (<|>)++instance Monoid x => Monoid (Parser g s x) where+   mempty = pure mempty+   mappend = liftA2 mappend++instance Factorial.FactorialMonoid s => Parsing (Parser g s) where+   try = id+   (<?>) = const+   eof = endOfInput+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   notFollowedBy (Parser p) = Parser q+      where q :: forall x. s -> (() -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' _ _ _ _ = failure (FailureInfo 1 (fromIntegral $ Factorial.length input) +                                                             ["notFollowedBy"])+                     failure' _ = success () 0 input failure++instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where+   lookAhead :: forall a. Parser g s a -> Parser g s a+   lookAhead (Parser p) = Parser q+      where q :: forall x. s -> (a -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' a _ _ = success a 0 input+                     failure' f = failure f++instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where+   satisfy = satisfyChar+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   char = satisfyChar . (==)+   notChar = satisfyChar . (/=)+   anyChar = satisfyChar (const True)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where+   someSpace = () <$ takeCharsWhile1 isSpace++instance MonoidParsing (Parser g) where+   endOfInput = Parser p+      where p rest success failure+               | Null.null rest = success () 0 rest failure+               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+   getInput = Parser p+      where p rest success failure = success rest len mempty failure+               where !len = Factorial.length rest+   anyToken = Parser p+      where p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) -> success first 1 suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+   satisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   satisfy predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) | predicate first -> success first 1 suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+   satisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s Char+   satisfyChar predicate = Parser p+      where p :: forall x. s -> (Char -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success first 1 suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   satisfyCharInput :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   satisfyCharInput predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success (Factorial.primePrefix rest) 1 suffix failure+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   notSatisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s ()+   notSatisfy predicate = Parser p+      where p :: forall x. s -> (() -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, _)+                     | predicate first -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfy"])+                  _ -> success () 0 rest failure+   notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()+   notSatisfyChar predicate = Parser p+      where p :: forall x. s -> (() -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.characterPrefix rest+               of Just first | predicate first+                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                  _ -> success () 0 rest failure+   scan :: forall t s. FactorialMonoid t => s -> (s -> t -> Maybe s) -> Parser g t t+   scan s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> Int -> t -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p s rest success failure = success prefix len suffix failure+               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest+                     !len = Factorial.length prefix+   scanChars :: forall t s. TextualMonoid t => s -> (s -> Char -> Maybe s) -> Parser g t t+   scanChars s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> Int -> t -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p s rest success failure = success prefix len suffix failure+               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest+                     !len = Factorial.length prefix+   takeWhile :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure +               | (prefix, suffix) <- Factorial.span predicate rest, +                 !len <- Factorial.length prefix = +                    success prefix len suffix failure+   takeWhile1 :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Factorial.span predicate rest, +                 !len <- Factorial.length prefix =+                    if len == 0+                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    else success prefix len suffix failure+   takeCharsWhile :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Textual.span_ False predicate rest, +                 !len <- Factorial.length prefix = success prefix len suffix failure+   takeCharsWhile1 :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | Null.null prefix = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])+               | otherwise = len `seq` success prefix len suffix failure+               where (prefix, suffix) = Textual.span_ False predicate rest+                     len = Factorial.length prefix+   string :: forall s. (Cancellative.LeftReductiveMonoid s, FactorialMonoid s, Show s) => s -> Parser g s s+   string s = Parser p where+      p :: forall x. s -> (s -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+      p s' success failure+         | Just suffix <- Cancellative.stripPrefix s s', !len <- Factorial.length s = success s len suffix failure+         | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+   whiteSpace = () <$ takeCharsWhile isSpace+   concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a+   concatMany (Parser p) = Parser q+      where q :: forall x. s -> (a -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q rest success failure = p rest success' (const $ success mempty 0 rest failure)+               where success' prefix !len suffix failure' =+                        q suffix +                          (\prefix' !len'-> success (prefix <> prefix') (len + len')) +                          (const $ success prefix len suffix failure')+   {-# INLINABLE string #-}++-- | Continuation-passing context-free parser that keeps track of the parsed prefix length+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>+--                  g (Continued.'Parser' g s) -> s -> g 'ParseResults'+-- @+instance MultiParsing Parser where+   type ResultFunctor Parser = ParseResults+   -- | Returns an input prefix parse paired with the remaining input suffix.+   parsePrefix g input = Rank2.fmap (Compose . (\p-> applyParser p input+                                                                 (\a _ rest _-> Right (rest, a))+                                                                 (Left . fromFailure input))) +                                    g+   parseComplete g input = Rank2.fmap (\p-> applyParser p input+                                                        (const . const . const . Right)+                                                        (Left . fromFailure input))+                                      (Rank2.fmap (<* endOfInput) g)++fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure+fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)

@@ -32,7 +32,7 @@ import Text.Grampa.Internal (BinTree(EmptyTree)) import Text.Grampa.ContextFree.Memoizing (ResultList(..), fromResultList) import qualified Text.Grampa.ContextFree.Memoizing as Memoizing-import qualified Text.Grampa.PEG.Backtrack.Length as Backtrack+import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack  import Prelude hiding (cycle, null, span, takeWhile) @@ -509,7 +509,7 @@  -- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list -- of input tails, opposite of 'peg'-longest :: FactorialMonoid s => Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a+longest :: Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a longest (PositiveDirectParser p) = PositiveDirectParser (Memoizing.longest p) longest p@DirectParser{} = DirectParser{complete= Memoizing.longest (complete p),                                         direct0=  Memoizing.longest (direct0 p),

@@ -31,7 +31,7 @@  import Text.Grampa.Class (GrammarParsing(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..)) import Text.Grampa.Internal (BinTree(..), FailureInfo(..))-import qualified Text.Grampa.PEG.Backtrack.Length as Backtrack+import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack  import Prelude hiding (iterate, length, null, showList, span, takeWhile) @@ -42,14 +42,14 @@ data ResultList g s r = ResultList !(BinTree (ResultInfo g s r)) {-# UNPACK #-} !FailureInfo data ResultInfo g s r = ResultInfo !Int ![(s, g (ResultList g s))] !r -instance (Show s, Show r) => Show (ResultList g s r) where+instance Show r => Show (ResultList g s r) where    show (ResultList l f) = "ResultList (" ++ shows l (") (" ++ shows f ")")  instance Show1 (ResultList g s) where    liftShowsPrec _sp showList _prec (ResultList l f) rest = "ResultList " ++ showList (simplify <$> toList l) (shows f rest)       where simplify (ResultInfo _ _ r) = r -instance (Show s, Show r) => Show (ResultInfo g s r) where+instance Show r => Show (ResultInfo g s r) where    show (ResultInfo l _ r) = "(ResultInfo @" ++ show l ++ " " ++ shows r ")"  instance Functor (ResultInfo g s) where@@ -262,7 +262,7 @@  -- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list -- of input tails, opposite of 'peg'-longest :: FactorialMonoid s => Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a+longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a longest p = Backtrack.Parser q where    q rest = case applyParser p rest             of ResultList EmptyTree failure -> Backtrack.NoParse failure

@@ -177,7 +177,7 @@            | otherwise = ResultList mempty (FailureInfo 1 (Factorial.length s') ["string " ++ show s])    whiteSpace = () <$ takeCharsWhile isSpace    concatMany (Parser p) = Parser q-      where q s = ResultList mempty failure <> foldMap continue rs+      where q s = ResultList (Leaf $ ResultInfo s mempty) failure <> foldMap continue rs                where ResultList rs failure = p s             continue (ResultInfo suffix prefix) = (prefix <>) <$> q suffix 

@@ -1,202 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--- | Backtracking parser for Parsing Expression Grammars, tracking the consumed input length-module Text.Grampa.PEG.Backtrack.Length (Parser(..), Result(..), alt) where--import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))--import Data.Char (isSpace)-import Data.Functor.Classes (Show1(..))-import Data.Functor.Compose (Compose(..))-import Data.List (nub)-import Data.Monoid (Monoid(mappend, mempty), (<>))-import Data.Monoid.Factorial(FactorialMonoid)-import Data.String (fromString)--import qualified Data.Monoid.Cancellative as Cancellative-import qualified Data.Monoid.Factorial as Factorial-import qualified Data.Monoid.Null as Null-import qualified Data.Monoid.Textual as Textual--import qualified Rank2--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(someSpace))-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))-import Text.Grampa.Internal (FailureInfo(..))--data Result (g :: (* -> *) -> *) s v = Parsed{parsedLength :: !Int,-                                              parsedResult :: !v,-                                              parsedSuffix :: !s}-                                     | NoParse FailureInfo---- | Parser type for Parsing Expression Grammars that uses a backtracking algorithm, fast for grammars in LL(1) class--- but with potentially exponential performance for longer ambiguous prefixes.-newtype Parser g s r = Parser{applyParser :: s -> Result g s r}--instance Show1 (Result g s) where-   liftShowsPrec showsPrecSub _showList prec Parsed{parsedResult= r} rest = "Parsed " ++ showsPrecSub prec r rest-   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest--instance Functor (Result g s) where-   fmap f (Parsed l a rest) = Parsed l (f a) rest-   fmap _ (NoParse failure) = NoParse failure-   -instance Functor (Parser g s) where-   fmap f (Parser p) = Parser (fmap f . p)-   {-# INLINABLE fmap #-}--instance Applicative (Parser g s) where-   pure a = Parser (Parsed 0 a)-   Parser p <*> Parser q = Parser r where-      r rest = case p rest-               of Parsed l f rest' -> case q rest'-                                      of Parsed l' a rest'' -> Parsed (l+l') (f a) rest''-                                         NoParse failure -> NoParse failure-                  NoParse failure -> NoParse failure-   {-# INLINABLE (<*>) #-}--instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])-   (<|>) = alt---- | A named and unconstrained version of the '<|>' operator-alt :: Parser g s a -> Parser g s a -> Parser g s a-Parser p `alt` Parser q = Parser r where-      r rest = case p rest-               of x@Parsed{} -> x-                  NoParse{} -> q rest--instance Monad (Parser g s) where-   return = pure-   Parser p >>= f = Parser r where-      r rest = case p rest-               of Parsed l a rest' -> case applyParser (f a) rest'-                                      of Parsed l' b rest'' -> Parsed (l+l') b rest''-                                         NoParse failure -> NoParse failure-                  NoParse failure -> NoParse failure--instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where-   mzero = empty-   mplus = (<|>)--instance Monoid x => Monoid (Parser g s x) where-   mempty = pure mempty-   mappend = liftA2 mappend--instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const-   eof = endOfInput-   unexpected msg = Parser (\t-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])-   notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))-      where rewind t Parsed{} = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length t) ["notFollowedBy"])-            rewind t NoParse{} = Parsed 0 () t--instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where-   lookAhead (Parser p) = Parser (\input-> rewind input (p input))-      where rewind t (Parsed _ r _) = Parsed 0 r t-            rewind _ r@NoParse{} = r--instance (Show s, Textual.TextualMonoid s) => CharParsing (Parser g s) where-   satisfy = satisfyChar-   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)-   char = satisfyChar . (==)-   notChar = satisfyChar . (/=)-   anyChar = satisfyChar (const True)-   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)--instance (Show s, Textual.TextualMonoid s) => TokenParsing (Parser g s) where-   someSpace = () <$ takeCharsWhile1 isSpace--instance MonoidParsing (Parser g) where-   endOfInput = Parser p-      where p rest-               | Null.null rest = Parsed 0 () rest-               | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])-   getInput = Parser p-      where p rest = Parsed (Factorial.length rest) rest mempty-   anyToken = Parser p-      where p rest = case Factorial.splitPrimePrefix rest-                     of Just (first, suffix) -> Parsed 1 first suffix-                        _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])-   satisfy predicate = Parser p-      where p rest =-               case Factorial.splitPrimePrefix rest-               of Just (first, suffix) | predicate first -> Parsed 1 first suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])-   satisfyChar predicate = Parser p-      where p rest =-               case Textual.splitCharacterPrefix rest-               of Just (first, suffix) | predicate first -> Parsed 1 first suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])-   satisfyCharInput predicate = Parser p-      where p rest =-               case Textual.splitCharacterPrefix rest-               of Just (first, suffix) | predicate first -> Parsed 1 (Factorial.primePrefix rest) suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])-   notSatisfy predicate = Parser p-      where p s = case Factorial.splitPrimePrefix s-                  of Just (first, _) -                        | predicate first -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s) ["notSatisfy"])-                     _ -> Parsed 0 () s-   notSatisfyChar predicate = Parser p-      where p s = case Textual.characterPrefix s-                  of Just first | predicate first -                                  -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s) ["notSatisfyChar"])-                     _ -> Parsed 0 () s-   scan s0 f = Parser (p s0)-      where p s rest = Parsed (Factorial.length prefix) prefix suffix-               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest-   scanChars s0 f = Parser (p s0)-      where p s rest = Parsed (Factorial.length prefix) prefix suffix-               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest-   takeWhile predicate = Parser p-      where p rest | (prefix, suffix) <- Factorial.span predicate rest =-               Parsed (Factorial.length prefix) prefix suffix-   takeWhile1 predicate = Parser p-      where p rest | (prefix, suffix) <- Factorial.span predicate rest =-                        if Null.null prefix-                        then NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])-                        else Parsed (Factorial.length prefix) prefix suffix-   takeCharsWhile predicate = Parser p-      where p rest | (prefix, suffix) <- Textual.span_ False predicate rest = -               Parsed (Factorial.length prefix) prefix suffix-   takeCharsWhile1 predicate = Parser p-      where p rest | (prefix, suffix) <- Textual.span_ False predicate rest =-                     if Null.null prefix-                     then NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])-                     else Parsed (Factorial.length prefix) prefix suffix-   string s = Parser p where-      p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed l s suffix-           | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])-      l = Factorial.length s-   whiteSpace = () <$ takeCharsWhile isSpace-   concatMany (Parser p) = Parser q-      where q rest = case p rest-                     of Parsed l prefix suffix -> let Parsed l' prefix' suffix' = q suffix-                                                  in Parsed (l+l') (prefix <> prefix') suffix'-                        NoParse{} -> Parsed 0 mempty rest-   {-# INLINABLE string #-}---- | Backtracking PEG parser------ @--- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>---                  g (Backtrack.'Parser' g s) -> s -> g 'ParseResults'--- @-instance MultiParsing Parser where-   type ResultFunctor Parser = ParseResults-   {-# NOINLINE parsePrefix #-}-   -- | Returns an input prefix parse paired with the remaining input suffix.-   parsePrefix g input = Rank2.fmap (Compose . fromResult input . (`applyParser` input)) g-   parseComplete g input = Rank2.fmap ((snd <$>) . fromResult input . (`applyParser` input))-                                      (Rank2.fmap (<* endOfInput) g)--fromResult :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)-fromResult s (NoParse (FailureInfo _ pos msgs)) =-   Left (ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs))-fromResult _ (Parsed _ prefix suffix) = Right (suffix, prefix)

@@ -0,0 +1,202 @@+{-# LANGUAGE TypeFamilies #-}+-- | Backtracking parser for Parsing Expression Grammars, tracking the consumed input length+module Text.Grampa.PEG.Backtrack.Measured (Parser(..), Result(..), alt) where++import Control.Applicative (Applicative(..), Alternative(..), liftA2)+import Control.Monad (Monad(..), MonadPlus(..))++import Data.Char (isSpace)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose (Compose(..))+import Data.List (nub)+import Data.Monoid (Monoid(mappend, mempty), (<>))+import Data.Monoid.Factorial(FactorialMonoid)+import Data.String (fromString)++import qualified Data.Monoid.Cancellative as Cancellative+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual++import qualified Rank2++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(someSpace))+import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))+import Text.Grampa.Internal (FailureInfo(..))++data Result (g :: (* -> *) -> *) s v = Parsed{parsedLength :: !Int,+                                              parsedResult :: !v,+                                              parsedSuffix :: !s}+                                     | NoParse FailureInfo++-- | Parser type for Parsing Expression Grammars that uses a backtracking algorithm, fast for grammars in LL(1) class+-- but with potentially exponential performance for longer ambiguous prefixes.+newtype Parser g s r = Parser{applyParser :: s -> Result g s r}++instance Show1 (Result g s) where+   liftShowsPrec showsPrecSub _showList prec Parsed{parsedResult= r} rest = "Parsed " ++ showsPrecSub prec r rest+   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest++instance Functor (Result g s) where+   fmap f (Parsed l a rest) = Parsed l (f a) rest+   fmap _ (NoParse failure) = NoParse failure+   +instance Functor (Parser g s) where+   fmap f (Parser p) = Parser (fmap f . p)+   {-# INLINABLE fmap #-}++instance Applicative (Parser g s) where+   pure a = Parser (Parsed 0 a)+   Parser p <*> Parser q = Parser r where+      r rest = case p rest+               of Parsed l f rest' -> case q rest'+                                      of Parsed l' a rest'' -> Parsed (l+l') (f a) rest''+                                         NoParse failure -> NoParse failure+                  NoParse failure -> NoParse failure+   {-# INLINABLE (<*>) #-}++instance Factorial.FactorialMonoid s => Alternative (Parser g s) where+   empty = Parser (\rest-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   (<|>) = alt++-- | A named and unconstrained version of the '<|>' operator+alt :: Parser g s a -> Parser g s a -> Parser g s a+Parser p `alt` Parser q = Parser r where+      r rest = case p rest+               of x@Parsed{} -> x+                  NoParse{} -> q rest++instance Monad (Parser g s) where+   return = pure+   Parser p >>= f = Parser r where+      r rest = case p rest+               of Parsed l a rest' -> case applyParser (f a) rest'+                                      of Parsed l' b rest'' -> Parsed (l+l') b rest''+                                         NoParse failure -> NoParse failure+                  NoParse failure -> NoParse failure++instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where+   mzero = empty+   mplus = (<|>)++instance Monoid x => Monoid (Parser g s x) where+   mempty = pure mempty+   mappend = liftA2 mappend++instance Factorial.FactorialMonoid s => Parsing (Parser g s) where+   try = id+   (<?>) = const+   eof = endOfInput+   unexpected msg = Parser (\t-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))+      where rewind t Parsed{} = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length t) ["notFollowedBy"])+            rewind t NoParse{} = Parsed 0 () t++instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where+   lookAhead (Parser p) = Parser (\input-> rewind input (p input))+      where rewind t (Parsed _ r _) = Parsed 0 r t+            rewind _ r@NoParse{} = r++instance (Show s, Textual.TextualMonoid s) => CharParsing (Parser g s) where+   satisfy = satisfyChar+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   char = satisfyChar . (==)+   notChar = satisfyChar . (/=)+   anyChar = satisfyChar (const True)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (Show s, Textual.TextualMonoid s) => TokenParsing (Parser g s) where+   someSpace = () <$ takeCharsWhile1 isSpace++instance MonoidParsing (Parser g) where+   endOfInput = Parser p+      where p rest+               | Null.null rest = Parsed 0 () rest+               | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+   getInput = Parser p+      where p rest = Parsed (Factorial.length rest) rest mempty+   anyToken = Parser p+      where p rest = case Factorial.splitPrimePrefix rest+                     of Just (first, suffix) -> Parsed 1 first suffix+                        _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+   satisfy predicate = Parser p+      where p rest =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) | predicate first -> Parsed 1 first suffix+                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+   satisfyChar predicate = Parser p+      where p rest =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> Parsed 1 first suffix+                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   satisfyCharInput predicate = Parser p+      where p rest =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> Parsed 1 (Factorial.primePrefix rest) suffix+                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   notSatisfy predicate = Parser p+      where p s = case Factorial.splitPrimePrefix s+                  of Just (first, _) +                        | predicate first -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s) ["notSatisfy"])+                     _ -> Parsed 0 () s+   notSatisfyChar predicate = Parser p+      where p s = case Textual.characterPrefix s+                  of Just first | predicate first +                                  -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s) ["notSatisfyChar"])+                     _ -> Parsed 0 () s+   scan s0 f = Parser (p s0)+      where p s rest = Parsed (Factorial.length prefix) prefix suffix+               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest+   scanChars s0 f = Parser (p s0)+      where p s rest = Parsed (Factorial.length prefix) prefix suffix+               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest+   takeWhile predicate = Parser p+      where p rest | (prefix, suffix) <- Factorial.span predicate rest =+               Parsed (Factorial.length prefix) prefix suffix+   takeWhile1 predicate = Parser p+      where p rest | (prefix, suffix) <- Factorial.span predicate rest =+                        if Null.null prefix+                        then NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                        else Parsed (Factorial.length prefix) prefix suffix+   takeCharsWhile predicate = Parser p+      where p rest | (prefix, suffix) <- Textual.span_ False predicate rest = +               Parsed (Factorial.length prefix) prefix suffix+   takeCharsWhile1 predicate = Parser p+      where p rest | (prefix, suffix) <- Textual.span_ False predicate rest =+                     if Null.null prefix+                     then NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])+                     else Parsed (Factorial.length prefix) prefix suffix+   string s = Parser p where+      p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed l s suffix+           | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+      l = Factorial.length s+   whiteSpace = () <$ takeCharsWhile isSpace+   concatMany (Parser p) = Parser q+      where q rest = case p rest+                     of Parsed l prefix suffix -> let Parsed l' prefix' suffix' = q suffix+                                                  in Parsed (l+l') (prefix <> prefix') suffix'+                        NoParse{} -> Parsed 0 mempty rest+   {-# INLINABLE string #-}++-- | Backtracking PEG parser+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>+--                  g (Backtrack.'Parser' g s) -> s -> g 'ParseResults'+-- @+instance MultiParsing Parser where+   type ResultFunctor Parser = ParseResults+   {-# NOINLINE parsePrefix #-}+   -- | Returns an input prefix parse paired with the remaining input suffix.+   parsePrefix g input = Rank2.fmap (Compose . fromResult input . (`applyParser` input)) g+   parseComplete g input = Rank2.fmap ((snd <$>) . fromResult input . (`applyParser` input))+                                      (Rank2.fmap (<* endOfInput) g)++fromResult :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)+fromResult s (NoParse (FailureInfo _ pos msgs)) =+   Left (ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs))+fromResult _ (Parsed _ prefix suffix) = Right (suffix, prefix)

@@ -0,0 +1,227 @@+{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+-- | Continuation-passing parser for Parsing Expression Grammars+module Text.Grampa.PEG.Continued (Parser(..), Result(..), alt) where++import Control.Applicative (Applicative(..), Alternative(..), liftA2)+import Control.Monad (Monad(..), MonadPlus(..))++import Data.Char (isSpace)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose (Compose(..))+import Data.List (nub)+import Data.Monoid (Monoid(mappend, mempty), (<>))+import Data.Monoid.Factorial(FactorialMonoid)+import Data.Monoid.Textual(TextualMonoid)+import Data.String (fromString)++import qualified Data.Monoid.Cancellative as Cancellative+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual++import qualified Rank2++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(someSpace))+import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))+import Text.Grampa.Internal (FailureInfo(..))++data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,+                                              parsedSuffix :: !s}+                                     | NoParse FailureInfo++-- | Parser type for Parsing Expression Grammars that uses a continuation-passing algorithm, fast for grammars in+-- LL(1) class but with potentially exponential performance for longer ambiguous prefixes.+newtype Parser (g :: (* -> *) -> *) s r =+   Parser{applyParser :: forall x. s -> (r -> s -> x) -> (FailureInfo -> x) -> x}++instance Show1 (Result g s) where+   liftShowsPrec showsPrecSub _showList prec Parsed{parsedPrefix= r} rest = "Parsed " ++ showsPrecSub prec r rest+   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest++instance Functor (Result g s) where+   fmap f (Parsed a rest) = Parsed (f a) rest+   fmap _ (NoParse failure) = NoParse failure+   +instance Functor (Parser g s) where+   fmap f (Parser p) = Parser (\input success-> p input (success . f))+   {-# INLINABLE fmap #-}++instance Applicative (Parser g s) where+   pure a = Parser (\input success _-> success a input)+   (<*>) :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b+   Parser p <*> Parser q = Parser r where+      r :: forall x. s -> (b -> s -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\f rest'-> q rest' (success . f) failure) failure+   {-# INLINABLE (<*>) #-}++instance Factorial.FactorialMonoid s => Alternative (Parser g s) where+   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   (<|>) = alt++-- | A named and unconstrained version of the '<|>' operator+alt :: forall g s a. Parser g s a -> Parser g s a -> Parser g s a+Parser p `alt` Parser q = Parser r where+   r :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x+   r rest success failure = p rest success (\f1-> q rest success $ \f2 -> failure (f1 <> f2))++instance Monad (Parser g s) where+   return = pure+   (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b+   Parser p >>= f = Parser r where+      r :: forall x. s -> (b -> s -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\a rest'-> applyParser (f a) rest' success failure) failure++instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where+   mzero = empty+   mplus = (<|>)++instance Monoid x => Monoid (Parser g s x) where+   mempty = pure mempty+   mappend = liftA2 mappend++instance Factorial.FactorialMonoid s => Parsing (Parser g s) where+   try = id+   (<?>) = const+   eof = endOfInput+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   notFollowedBy (Parser p) = Parser q+      where q :: forall x. s -> (() -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' _ _ = failure (FailureInfo 1 (fromIntegral $ Factorial.length input) ["notFollowedBy"])+                     failure' _ = success () input++instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where+   lookAhead :: forall a. Parser g s a -> Parser g s a+   lookAhead (Parser p) = Parser q+      where q :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' a _ = success a input+                     failure' f = failure f++instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where+   satisfy = satisfyChar+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   char = satisfyChar . (==)+   notChar = satisfyChar . (/=)+   anyChar = satisfyChar (const True)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where+   someSpace = () <$ takeCharsWhile1 isSpace++instance MonoidParsing (Parser g) where+   endOfInput = Parser p+      where p rest success failure+               | Null.null rest = success () rest+               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+   getInput = Parser p+      where p rest success _ = success rest mempty+   anyToken = Parser p+      where p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) -> success first suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+   satisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   satisfy predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) | predicate first -> success first suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+   satisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s Char+   satisfyChar predicate = Parser p+      where p :: forall x. s -> (Char -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success first suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   satisfyCharInput :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   satisfyCharInput predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success (Factorial.primePrefix rest) suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   notSatisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s ()+   notSatisfy predicate = Parser p+      where p :: forall x. s -> (() -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, _)+                     | predicate first -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfy"])+                  _ -> success () rest+   notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()+   notSatisfyChar predicate = Parser p+      where p :: forall x. s -> (() -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.characterPrefix rest+               of Just first | predicate first+                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                  _ -> success () rest+   scan :: forall t s. FactorialMonoid t => s -> (s -> t -> Maybe s) -> Parser g t t+   scan s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> t -> x) -> (FailureInfo -> x) -> x+            p s rest success _ = success prefix suffix+               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest+   scanChars :: forall t s. TextualMonoid t => s -> (s -> Char -> Maybe s) -> Parser g t t+   scanChars s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> t -> x) -> (FailureInfo -> x) -> x+            p s rest success _ = success prefix suffix+               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest+   takeWhile :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success _ | (prefix, suffix) <- Factorial.span predicate rest = success prefix suffix+   takeWhile1 :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Factorial.span predicate rest =+                    if Null.null prefix+                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    else success prefix suffix+   takeCharsWhile :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success _ | (prefix, suffix) <- Textual.span_ False predicate rest = success prefix suffix+   takeCharsWhile1 :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | Null.null prefix = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])+               | otherwise = success prefix suffix+               where (prefix, suffix) = Textual.span_ False predicate rest+   string :: forall s. (Cancellative.LeftReductiveMonoid s, FactorialMonoid s, Show s) => s -> Parser g s s+   string s = Parser p where+      p :: forall x. s -> (s -> s -> x) -> (FailureInfo -> x) -> x+      p s' success failure+         | Just suffix <- Cancellative.stripPrefix s s' = success s suffix+         | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+   whiteSpace = () <$ takeCharsWhile isSpace+   concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a+   concatMany (Parser p) = Parser q+      where q :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x+            q rest success _ = p rest success' failure+               where success' prefix suffix = q suffix (success . (prefix <>)) (const $ success prefix suffix)+                     failure _ = success mempty rest+   {-# INLINABLE string #-}++-- | Continuation-passing PEG parser+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>+--                  g (Continued.'Parser' g s) -> s -> g 'ParseResults'+-- @+instance MultiParsing Parser where+   type ResultFunctor Parser = ParseResults+   -- | Returns an input prefix parse paired with the remaining input suffix.+   parsePrefix g input = Rank2.fmap (Compose . (\p-> applyParser p input (flip $ curry Right) (Left . fromFailure input))) g+   parseComplete g input = Rank2.fmap (\p-> applyParser p input (const . Right) (Left . fromFailure input))+                                      (Rank2.fmap (<* endOfInput) g)++fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure+fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)

@@ -0,0 +1,242 @@+{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+-- | Continuation-passing parser for Parsing Expression Grammars that keeps track of the parsed prefix length+module Text.Grampa.PEG.Continued.Measured (Parser(..), Result(..), alt) where++import Control.Applicative (Applicative(..), Alternative(..), liftA2)+import Control.Monad (Monad(..), MonadPlus(..))++import Data.Char (isSpace)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose (Compose(..))+import Data.List (nub)+import Data.Monoid (Monoid(mappend, mempty), (<>))+import Data.Monoid.Factorial(FactorialMonoid)+import Data.Monoid.Textual(TextualMonoid)+import Data.String (fromString)++import qualified Data.Monoid.Cancellative as Cancellative+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual++import qualified Rank2++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(someSpace))+import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))+import Text.Grampa.Internal (FailureInfo(..))++data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,+                                              parsedSuffix :: !s}+                                     | NoParse FailureInfo++-- | Parser type for Parsing Expression Grammars that uses a continuation-passing algorithm and keeps track of the+-- parsed prefix length, fast for grammars in LL(1) class but with potentially exponential performance for longer+-- ambiguous prefixes.+newtype Parser (g :: (* -> *) -> *) s r =+   Parser{applyParser :: forall x. s -> (r -> Int -> s -> x) -> (FailureInfo -> x) -> x}++instance Show1 (Result g s) where+   liftShowsPrec showsPrecSub _showList prec Parsed{parsedPrefix= r} rest = "Parsed " ++ showsPrecSub prec r rest+   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest++instance Functor (Result g s) where+   fmap f (Parsed a rest) = Parsed (f a) rest+   fmap _ (NoParse failure) = NoParse failure+   +instance Functor (Parser g s) where+   fmap f (Parser p) = Parser (\input success-> p input (success . f))+   {-# INLINABLE fmap #-}++instance Applicative (Parser g s) where+   pure a = Parser (\input success _-> success a 0 input)+   (<*>) :: forall a b. Parser g s (a -> b) -> Parser g s a -> Parser g s b+   Parser p <*> Parser q = Parser r where+      r :: forall x. s -> (b -> Int -> s -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest (\f len rest'-> q rest' (\a len'-> success (f a) $! len + len') failure) failure+   {-# INLINABLE (<*>) #-}++instance Factorial.FactorialMonoid s => Alternative (Parser g s) where+   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   (<|>) = alt++-- | A named and unconstrained version of the '<|>' operator+alt :: forall g s a. Parser g s a -> Parser g s a -> Parser g s a+Parser p `alt` Parser q = Parser r where+   r :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x+   r rest success failure = p rest success (\f1-> q rest success $ \f2 -> failure (f1 <> f2))++instance Monad (Parser g s) where+   return = pure+   (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b+   Parser p >>= f = Parser r where+      r :: forall x. s -> (b -> Int -> s -> x) -> (FailureInfo -> x) -> x+      r rest success failure = p rest +                                 (\a len rest'-> applyParser (f a) rest' (\b len'-> success b $! len + len') failure)+                                 failure++instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where+   mzero = empty+   mplus = (<|>)++instance Monoid x => Monoid (Parser g s x) where+   mempty = pure mempty+   mappend = liftA2 mappend++instance Factorial.FactorialMonoid s => Parsing (Parser g s) where+   try = id+   (<?>) = const+   eof = endOfInput+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   notFollowedBy (Parser p) = Parser q+      where q :: forall x. s -> (() -> Int -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' _ _ _ = failure (FailureInfo 1 (fromIntegral $ Factorial.length input) ["notFollowedBy"])+                     failure' _ = success () 0 input++instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where+   lookAhead :: forall a. Parser g s a -> Parser g s a+   lookAhead (Parser p) = Parser q+      where q :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success' failure'+               where success' a _ _ = success a 0 input+                     failure' f = failure f++instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where+   satisfy = satisfyChar+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   char = satisfyChar . (==)+   notChar = satisfyChar . (/=)+   anyChar = satisfyChar (const True)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where+   someSpace = () <$ takeCharsWhile1 isSpace++instance MonoidParsing (Parser g) where+   endOfInput = Parser p+      where p rest success failure+               | Null.null rest = success () 0 rest+               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+   getInput = Parser p+      where p rest success _ = success rest len mempty+               where !len = Factorial.length rest+   anyToken = Parser p+      where p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) -> success first 1 suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+   satisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   satisfy predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, suffix) | predicate first -> success first 1 suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+   satisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s Char+   satisfyChar predicate = Parser p+      where p :: forall x. s -> (Char -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success first 1 suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   satisfyCharInput :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   satisfyCharInput predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.splitCharacterPrefix rest+               of Just (first, suffix) | predicate first -> success (Factorial.primePrefix rest) 1 suffix+                  _ -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+   notSatisfy :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s ()+   notSatisfy predicate = Parser p+      where p :: forall x. s -> (() -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Factorial.splitPrimePrefix rest+               of Just (first, _)+                     | predicate first -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfy"])+                  _ -> success () 0 rest+   notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()+   notSatisfyChar predicate = Parser p+      where p :: forall x. s -> (() -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure =+               case Textual.characterPrefix rest+               of Just first | predicate first+                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                  _ -> success () 0 rest+   scan :: forall t s. FactorialMonoid t => s -> (s -> t -> Maybe s) -> Parser g t t+   scan s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> Int -> t -> x) -> (FailureInfo -> x) -> x+            p s rest success _ = success prefix len suffix+               where (prefix, suffix, _) = Factorial.spanMaybe' s f rest+                     !len = Factorial.length prefix+   scanChars :: forall t s. TextualMonoid t => s -> (s -> Char -> Maybe s) -> Parser g t t+   scanChars s0 f = Parser (p s0)+      where p :: forall x. s -> t -> (t -> Int -> t -> x) -> (FailureInfo -> x) -> x+            p s rest success _ = success prefix len suffix+               where (prefix, suffix, _) = Textual.spanMaybe_' s f rest+                     !len = Factorial.length prefix+   takeWhile :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success _ +               | (prefix, suffix) <- Factorial.span predicate rest, +                 !len <- Factorial.length prefix = success prefix len suffix+   takeWhile1 :: forall s. FactorialMonoid s => (s -> Bool) -> Parser g s s+   takeWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | (prefix, suffix) <- Factorial.span predicate rest, +                 !len <- Factorial.length prefix =+                    if len == 0+                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    else success prefix len suffix+   takeCharsWhile :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success _ +               | (prefix, suffix) <- Textual.span_ False predicate rest, +                 !len <- Factorial.length prefix = success prefix len suffix+   takeCharsWhile1 :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s+   takeCharsWhile1 predicate = Parser p+      where p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+            p rest success failure+               | Null.null prefix = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])+               | otherwise = success prefix len suffix+               where (prefix, suffix) = Textual.span_ False predicate rest+                     !len = Factorial.length prefix+   string :: forall s. (Cancellative.LeftReductiveMonoid s, FactorialMonoid s, Show s) => s -> Parser g s s+   string s = Parser p where+      p :: forall x. s -> (s -> Int -> s -> x) -> (FailureInfo -> x) -> x+      p s' success failure+         | Just suffix <- Cancellative.stripPrefix s s', !len <- Factorial.length s = success s len suffix+         | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+   whiteSpace = () <$ takeCharsWhile isSpace+   concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a+   concatMany (Parser p) = Parser q+      where q :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x+            q rest success _ = p rest success' failure+               where success' prefix !len suffix = +                        q suffix (\prefix' !len'-> success (prefix <> prefix') (len + len')) +                          (const $ success prefix len suffix)+                     failure _ = success mempty 0 rest+   {-# INLINABLE string #-}++-- | Continuation-passing PEG parser that keeps track of the parsed prefix length+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>+--                  g (Continued.'Parser' g s) -> s -> g 'ParseResults'+-- @+instance MultiParsing Parser where+   type ResultFunctor Parser = ParseResults+   -- | Returns an input prefix parse paired with the remaining input suffix.+   parsePrefix g input = Rank2.fmap (Compose . (\p-> applyParser p input (\a _ rest-> Right (rest, a)) +                                                                 (Left . fromFailure input))) g+   parseComplete g input = Rank2.fmap (\p-> applyParser p input (const . const . Right) (Left . fromFailure input))+                                      (Rank2.fmap (<* endOfInput) g)++fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure+fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)