packages feed

grammatical-parsers 0.3 → 0.3.1

raw patch · 16 files changed

+350/−213 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Text.Grampa: showFailure :: TextualMonoid s => s -> ParseFailure -> Int -> String
+ Text.Grampa.Combinators: concatMany :: (MonoidParsing m, Monoid a) => m s a -> m s a
+ Text.Grampa.Combinators: concatSome :: (Monoid x, Applicative (p s), MonoidParsing p) => p s x -> p s x
+ Text.Grampa.Combinators: count :: Applicative m => Int -> m a -> m [a]
+ Text.Grampa.Combinators: delimiter :: (Show s, FactorialMonoid s, LeftReductiveMonoid s, Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s
+ Text.Grampa.Combinators: flag :: Alternative p => p a -> p Bool
+ Text.Grampa.Combinators: keyword :: (Lexical g, LexicalConstraint m g s) => s -> m g s ()
+ Text.Grampa.Combinators: moptional :: (Monoid x, Alternative p) => p x -> p x
+ Text.Grampa.Combinators: operator :: (Show s, FactorialMonoid s, LeftReductiveMonoid s, Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s
+ Text.Grampa.Combinators: upto :: Alternative p => Int -> p a -> p [a]
- Text.Grampa: concatMany :: (MonoidParsing m, Monoid a) => m s a -> m s a
+ Text.Grampa: concatMany :: (MonoidParsing m, Monoid a, Alternative (m s)) => m s a -> m s a
- Text.Grampa: identifier :: (Lexical g, LexicalConstraint m g s, Monad (m g s), Alternative (m g s), MonoidParsing (m g), TextualMonoid s) => m g s s
+ Text.Grampa: identifier :: (Lexical g, LexicalConstraint m g s, Monad (m g s), Alternative (m g s), Parsing (m g s), MonoidParsing (m g), TextualMonoid s) => m g s s
- Text.Grampa.ContextFree.Memoizing: FailureInfo :: !Int -> Word64 -> [String] -> FailureInfo
+ Text.Grampa.ContextFree.Memoizing: FailureInfo :: Word64 -> [String] -> FailureInfo
- Text.Grampa.ContextFree.Parallel: FailureInfo :: !Int -> Int -> [String] -> FailureInfo
+ Text.Grampa.ContextFree.Parallel: FailureInfo :: Int -> [String] -> FailureInfo
- Text.Grampa.ContextFree.SortedMemoizing: FailureInfo :: !Int -> Word64 -> [String] -> FailureInfo
+ Text.Grampa.ContextFree.SortedMemoizing: FailureInfo :: Word64 -> [String] -> FailureInfo

Files

README.md view
@@ -92,12 +92,12 @@ --   product=Compose (Left (ParseFailure 1 ["endOfInput"])), --   factor=Compose (Left (ParseFailure 1 ["endOfInput"])), --   number=Compose (Left (ParseFailure 1 ["endOfInput"]))}--- >>> parsePrefix grammar "1+2*3"+-- >>> parsePrefix grammar "1+2*3 apples" -- Arithmetic{---   sum=Compose (Compose (Right [("+2*3",1),("*3",3),("",7)])),---   product=Compose (Compose (Right [("+2*3",1)])),---   factor=Compose (Compose (Right [("+2*3",1)])),---   number=Compose (Compose (Right [("+2*3","1")]))}+--   sum=Compose (Compose (Right [("+2*3 apples",1),("*3 apples",3),(" apples",7)])),+--   product=Compose (Compose (Right [("+2*3 apples",1)])),+--   factor=Compose (Compose (Right [("+2*3 apples",1)])),+--   number=Compose (Compose (Right [("+2*3 apples","1")]))} ~~~  To see more grammar examples, go straight to the@@ -105,5 +105,5 @@ smaller grammars and combines them all together in the [Combined](https://github.com/blamario/grampa/blob/master/grammatical-parsers/examples/Combined.hs) module. -For more conventional tastes there is a monolithic-[Lua grammar](https://github.com/blamario/language-lua2/blob/master/src/Language/Lua/Grammar.hs) example as well.+For more conventional tastes there are monolithic examples of+[Lua](https://github.com/blamario/language-lua2/blob/master/src/Language/Lua/Grammar.hs) and [Oberon](http://hackage.haskell.org/package/language-oberon) grammars as well.
grammatical-parsers.cabal view
@@ -1,6 +1,6 @@ name:                grammatical-parsers-version:             0.3-synopsis:            parsers that can combine into grammars+version:             0.3.1+synopsis:            parsers that 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   to grammar record fields. All parser types support the same set of parser combinators, but have different semantics@@ -24,6 +24,7 @@ library   hs-source-dirs:      src   exposed-modules:     Text.Grampa,+                       Text.Grampa.Combinators,                        Text.Grampa.PEG.Backtrack, Text.Grampa.PEG.Packrat,                        Text.Grampa.ContextFree.Continued, Text.Grampa.ContextFree.Parallel,                        Text.Grampa.ContextFree.Memoizing, Text.Grampa.ContextFree.SortedMemoizing,
src/Text/Grampa.hs view
@@ -4,7 +4,7 @@ module Text.Grampa (    -- * Parsing methods    MultiParsing(..),-   simply,+   showFailure, simply,    -- * Types    Grammar, GrammarBuilder, ParseResults, ParseFailure(..), Ambiguous(..),    -- * Parser combinators and primitives@@ -14,6 +14,9 @@    module Text.Parser.LookAhead) where +import Data.List (intercalate)+import Data.Monoid ((<>))+import Data.Monoid.Textual (TextualMonoid, toString) import Text.Parser.Char (CharParsing(char, notChar, anyChar)) import Text.Parser.Combinators (Parsing((<?>), notFollowedBy, skipMany, skipSome, unexpected)) import Text.Parser.LookAhead (LookAheadParsing(lookAhead))@@ -36,3 +39,27 @@ -- | Apply the given 'parse' function to the given grammar-free parser and its input. simply :: (Rank2.Only r (p (Rank2.Only r) s) -> s -> Rank2.Only r f) -> p (Rank2.Only r) s r -> s -> f r simply parseGrammar p input = Rank2.fromOnly (parseGrammar (Rank2.Only p) input)++-- | Given the textual parse input, the parse failure on the input, and the number of lines preceding the failure to+-- show, produce a human-readable failure description.+showFailure :: TextualMonoid s => s -> ParseFailure -> Int -> String+showFailure input (ParseFailure pos expected) preceding =+   unlines prevLines <> replicate column ' ' <> "^\n"+   <> "at line " <> show (length allPrevLines) <> ", column " <> show column <> "\n"+   <> "expected " <> oxfordComma expected+   where oxfordComma [] = []+         oxfordComma [x] = x+         oxfordComma [x, y] = x <> " or " <> y+         oxfordComma (x:y:rest) = intercalate ", " (x : y : onLast ("or " <>) rest)+         onLast _ [] = []+         onLast f [x] = [f x]+         onLast f (x:xs) = x : onLast f xs+         (allPrevLines, column) = context [] pos (lines $ toString (const mempty) input)+         prevLines = reverse (take (succ preceding) allPrevLines)+         context revLines restCount []+            | restCount > 0 = (["Error: the failure position is beyond the input length"], -1)+            | otherwise = (revLines, restCount)+         context revLines restCount (next:rest)+            | restCount < nextLength = (next:revLines, restCount)+            | otherwise = context (next:revLines) (restCount - nextLength - 1) rest+            where nextLength = length next
src/Text/Grampa/Class.hs view
@@ -4,7 +4,6 @@                           ParseResults, ParseFailure(..), Ambiguous(..), completeParser) where  import Control.Applicative (Alternative(empty), liftA2, (<|>))-import Control.Monad (guard) import Data.Char (isAlphaNum, isLetter, isSpace) import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -17,9 +16,9 @@ import Data.Monoid.Null (MonoidNull) import Data.Monoid.Factorial (FactorialMonoid) import Data.Monoid.Textual (TextualMonoid)-import Text.Parser.Combinators (Parsing(notFollowedBy), skipMany, skipSome)+import Text.Parser.Combinators (Parsing(notFollowedBy, (<?>)), skipMany) import Text.Parser.Char (CharParsing(char))-import Text.Parser.Token (TokenParsing, IdentifierStyle)+import Text.Parser.Token (TokenParsing) import GHC.Exts (Constraint)  import qualified Rank2@@ -131,6 +130,9 @@    takeCharsWhile1 :: TextualMonoid s => (Char -> Bool) -> m s s    -- | Zero or more argument occurrences like 'many', with concatenated monoidal results.    concatMany :: Monoid a => m s a -> m s a+   default concatMany :: (Monoid a, Alternative (m s)) => m s a -> m s a+   concatMany p = go+      where go = mappend <$> p <*> go <|> pure mempty  -- | Parsers that can produce alternative parses and collect them into an 'Ambiguous' node class AmbiguousParsing m where@@ -181,7 +183,7 @@    default identifierToken :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)                            => m g s s -> m g s s    default identifier :: (LexicalConstraint m g s, Monad (m g s), Alternative (m g s),-                          MonoidParsing (m g), TextualMonoid s) => m g s s+                          Parsing (m g s), MonoidParsing (m g), TextualMonoid s) => m g s s    default keyword :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), Show s, TextualMonoid s)                    => s -> m g s ()    lexicalWhiteSpace = takeCharsWhile isSpace *> skipMany (lexicalComment *> takeCharsWhile isSpace)@@ -193,6 +195,6 @@    isIdentifierStartChar c = isLetter c || c == '_'    isIdentifierFollowChar c = isAlphaNum c || c == '_'    identifier = identifierToken (liftA2 (<>) (satisfyCharInput (isIdentifierStartChar @g))-                                             (takeCharsWhile (isIdentifierFollowChar @g)))+                                             (takeCharsWhile (isIdentifierFollowChar @g))) <?> "an identifier"    identifierToken = lexicalToken-   keyword s = lexicalToken (string s *> notSatisfyChar (isIdentifierFollowChar @g))+   keyword s = lexicalToken (string s *> notSatisfyChar (isIdentifierFollowChar @g)) <?> ("keyword " <> show s)
+ src/Text/Grampa/Combinators.hs view
@@ -0,0 +1,41 @@+module Text.Grampa.Combinators (moptional, concatMany, concatSome,+                                flag, count, upto,+                                delimiter, operator, keyword) where++import Control.Applicative(Applicative(..), Alternative(..))+import Data.Monoid.Cancellative (LeftReductiveMonoid)+import Data.Monoid (Monoid, (<>))+import Data.Monoid.Factorial (FactorialMonoid)++import Text.Grampa.Class (MonoidParsing(concatMany, string), +                          Lexical(LexicalConstraint, lexicalToken, keyword))+import Text.Parser.Combinators (Parsing((<?>)), count)++-- | Attempts to parse a monoidal value, if the argument parser fails returns 'mempty'.+moptional :: (Monoid x, Alternative p) => p x -> p x+moptional p = p <|> pure mempty++-- | One or more argument occurrences like 'some', with concatenated monoidal results.+concatSome :: (Monoid x, Applicative (p s), MonoidParsing p) => p s x -> p s x+concatSome p = (<>) <$> p <*> concatMany p++-- | Returns 'True' if the argument parser succeeds and 'False' otherwise.+flag :: Alternative p => p a -> p Bool+flag p = True <$ p <|> pure False++-- | Parses between 0 and N occurrences of the argument parser in sequence and returns the list of results.+upto :: Alternative p => Int -> p a -> p [a]+upto n p+   | n > 0 = (:) <$> p <*> upto (pred n) p +             <|> pure []+   | otherwise = pure []++-- | Parses the given delimiter, such as a comma or a brace+delimiter :: (Show s, FactorialMonoid s, LeftReductiveMonoid s,+              Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s+delimiter s = lexicalToken (string s) <?> ("delimiter " <> show s)++-- | Parses the given operator symbol+operator :: (Show s, FactorialMonoid s, LeftReductiveMonoid s,+             Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s+operator s = lexicalToken (string s) <?> ("operator " <> show s)
src/Text/Grampa/ContextFree/Continued.hs view
@@ -60,7 +60,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest _ failure-> failure $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -90,14 +90,24 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try :: forall a. Parser g s a -> Parser g s a+   try (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 . rewindFailure)+               where rewindFailure (FailureInfo _pos _msgs) = FailureInfo (fromIntegral $ Factorial.length input) []+   (<?>) :: forall a. Parser g s a -> String -> Parser g s a+   Parser p <?> msg  = Parser q+      where q :: forall x. s -> (a -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . replaceFailure)+               where replaceFailure (FailureInfo pos msgs) =+                        FailureInfo pos (if pos == fromIntegral (Factorial.length input) then [msg] else msgs)+    eof = endOfInput-   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo (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"])+               where success' _ _ _ = failure (FailureInfo (fromIntegral $ Factorial.length input) ["notFollowedBy"])                      failure' _ = success () input failure  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -125,42 +135,42 @@    endOfInput = Parser p       where p rest success failure                | Null.null rest = success () rest failure-               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                     | predicate first -> failure (FailureInfo (fromIntegral $ Factorial.length rest) ["notSatisfy"])                   _ -> success () rest failure    notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()    notSatisfyChar predicate = Parser p@@ -168,7 +178,7 @@             p rest success failure =                case Textual.characterPrefix rest                of Just first | predicate first-                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                               -> failure (FailureInfo (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)@@ -190,7 +200,7 @@             p rest success failure                | (prefix, suffix) <- Factorial.span predicate rest =                     if Null.null prefix-                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    then failure (FailureInfo (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@@ -201,7 +211,7 @@    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"])+               | Null.null prefix = failure (FailureInfo (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@@ -209,7 +219,7 @@       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])+         | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])    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@@ -232,4 +242,4 @@                                       (Rank2.fmap (<* endOfInput) g)  fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure-fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)+fromFailure s (FailureInfo pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)
src/Text/Grampa/ContextFree/Continued/Measured.hs view
@@ -60,7 +60,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest _ failure-> failure $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -92,14 +92,23 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try :: forall a. Parser g s a -> Parser g s a+   try (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 . rewindFailure)+               where rewindFailure (FailureInfo _pos _msgs) = FailureInfo (fromIntegral $ Factorial.length input) []+   (<?>) :: forall a. Parser g s a -> String -> Parser g s a+   Parser p <?> msg  = Parser q+      where q :: forall x. s -> (a -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . replaceFailure)+               where replaceFailure (FailureInfo pos msgs) =+                        FailureInfo pos (if pos == fromIntegral (Factorial.length input) then [msg] else msgs)    eof = endOfInput-   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo (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) +               where success' _ _ _ _ = failure (FailureInfo (fromIntegral $ Factorial.length input)                                                               ["notFollowedBy"])                      failure' _ = success () 0 input failure @@ -128,7 +137,7 @@    endOfInput = Parser p       where p rest success failure                | Null.null rest = success () 0 rest failure-               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length rest) ["endOfInput"])    getInput = Parser p       where p rest success failure = success rest len mempty failure                where !len = Factorial.length rest@@ -136,35 +145,35 @@       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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                     | predicate first -> failure (FailureInfo (fromIntegral $ Factorial.length rest) ["notSatisfy"])                   _ -> success () 0 rest failure    notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()    notSatisfyChar predicate = Parser p@@ -172,7 +181,7 @@             p rest success failure =                case Textual.characterPrefix rest                of Just first | predicate first-                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                               -> failure (FailureInfo (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)@@ -200,7 +209,7 @@                | (prefix, suffix) <- Factorial.span predicate rest,                   !len <- Factorial.length prefix =                     if len == 0-                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    then failure (FailureInfo (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@@ -212,7 +221,7 @@    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"])+               | Null.null prefix = failure (FailureInfo (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@@ -221,7 +230,7 @@       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])+         | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])    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@@ -251,4 +260,4 @@                                       (Rank2.fmap (<* endOfInput) g)  fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure-fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)+fromFailure s (FailureInfo pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)
src/Text/Grampa/ContextFree/Memoizing.hs view
@@ -83,7 +83,7 @@    {-# INLINABLE (<*>) #-}  instance Alternative (Parser g i) where-   empty = Parser (\rest-> ResultList mempty $ FailureInfo 0 (genericLength rest) ["empty"])+   empty = Parser (\rest-> ResultList mempty $ FailureInfo (genericLength rest) ["empty"])    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest    {-# INLINABLE (<|>) #-}@@ -119,7 +119,7 @@    type GrammarFunctor Parser = ResultList    nonTerminal f = Parser p where       p ((_, d) : _) = f d-      p _ = ResultList mempty (FailureInfo 1 0 ["NonTerminal at endOfInput"])+      p _ = ResultList mempty (FailureInfo 0 ["NonTerminal at endOfInput"])    {-# INLINE nonTerminal #-}  -- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left@@ -158,26 +158,26 @@    anyToken = Parser p       where p rest@((s, _):t) = case splitPrimePrefix s                                 of Just (first, _) -> ResultList (Leaf $ ResultInfo 1 t first) mempty-                                   _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["anyToken"])-            p [] = ResultList mempty (FailureInfo 1 0 ["anyToken"])+                                   _ -> ResultList mempty (FailureInfo (genericLength rest) ["anyToken"])+            p [] = ResultList mempty (FailureInfo 0 ["anyToken"])    satisfy predicate = Parser p       where p rest@((s, _):t) =                case splitPrimePrefix s                of Just (first, _) | predicate first -> ResultList (Leaf $ ResultInfo 1 t first) mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfy"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfy"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfy"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfy"])    satisfyChar predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> ResultList (Leaf $ ResultInfo 1 t first) mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyChar"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyChar"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfyChar"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfyChar"])    satisfyCharInput predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> ResultList (Leaf $ ResultInfo 1 t $ Factorial.primePrefix s) mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyCharInput"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyCharInput"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfyCharInput"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfyCharInput"])    scan s0 f = Parser (p s0)       where p s rest@((i, _) : _) = ResultList (Leaf $ ResultInfo l (drop l rest) prefix) mempty                where (prefix, _, _) = Factorial.spanMaybe' s f i@@ -197,7 +197,7 @@       where p rest@((s, _) : _)                | x <- Factorial.takeWhile predicate s, l <- Factorial.length x, l > 0 =                     ResultList (Leaf $ ResultInfo l (drop l rest) x) mempty-            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeWhile1"])+            p rest = ResultList mempty (FailureInfo (genericLength rest) ["takeWhile1"])    takeCharsWhile predicate = Parser p       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x =@@ -207,41 +207,44 @@       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x, l > 0 =                     ResultList (Leaf $ ResultInfo l (drop l rest) x) mempty-            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeCharsWhile1"])+            p rest = ResultList mempty (FailureInfo (genericLength rest) ["takeCharsWhile1"])    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = ResultList (Leaf $ ResultInfo l (Factorial.drop l rest) s) mempty-      p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["string " ++ show s])+      p rest = ResultList mempty (FailureInfo (genericLength rest) ["string " ++ show s])       l = Factorial.length s-   concatMany p = go-      where go = mempty <|> mappend <$> p <*> go    notSatisfy predicate = Parser p       where p rest@((s, _):_)                | Just (first, _) <- splitPrimePrefix s, -                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfy"])+                 predicate first = ResultList mempty (FailureInfo (genericLength rest) ["notSatisfy"])             p rest = ResultList (Leaf $ ResultInfo 0 rest ()) mempty    notSatisfyChar predicate = Parser p       where p rest@((s, _):_)                | Just first <- Textual.characterPrefix s, -                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfyChar"])+                 predicate first = ResultList mempty (FailureInfo (genericLength rest) ["notSatisfyChar"])             p rest = ResultList (Leaf $ ResultInfo 0 rest ()) mempty    {-# INLINABLE string #-}  instance MonoidNull s => Parsing (Parser g s) where-   try (Parser p) = Parser (weakenResults . p)-      where weakenResults (ResultList rl (FailureInfo s pos msgs)) = ResultList rl (FailureInfo (pred s) pos msgs)-   Parser p <?> msg  = Parser (strengthenResults . p)-      where strengthenResults (ResultList rl (FailureInfo s pos _msgs)) = ResultList rl (FailureInfo (succ s) pos [msg])+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (ResultList rl (FailureInfo _pos _msgs)) =+                        ResultList rl (FailureInfo (genericLength rest) [])+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (ResultList EmptyTree (FailureInfo pos msgs)) =+                        ResultList EmptyTree (FailureInfo pos $ if pos == genericLength rest then [msg] else msgs)+                     replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList EmptyTree _) = ResultList (Leaf $ ResultInfo 0 t ()) mempty-            rewind t ResultList{} = ResultList mempty (FailureInfo 1 (genericLength t) ["notFollowedBy"])+            rewind t ResultList{} = ResultList mempty (FailureInfo (genericLength t) ["notFollowedBy"])    skipMany p = go       where go = pure () <|> p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo 0 (genericLength t) [msg])+   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo (genericLength t) [msg])    eof = Parser f       where f rest@((s, _):_)                | null s = ResultList (Leaf $ ResultInfo 0 rest ()) mempty-               | otherwise = ResultList mempty (FailureInfo 1 (genericLength rest) ["endOfInput"])+               | otherwise = ResultList mempty (FailureInfo (genericLength rest) ["endOfInput"])             f [] = ResultList (Leaf $ ResultInfo 0 [] ()) mempty  instance MonoidNull s => LookAheadParsing (Parser g s) where@@ -263,7 +266,7 @@    token = lexicalToken  fromResultList :: FactorialMonoid s => s -> ResultList g s r -> ParseResults [(s, r)]-fromResultList s (ResultList EmptyTree (FailureInfo _ pos msgs)) =+fromResultList s (ResultList EmptyTree (FailureInfo pos msgs)) =    Left (ParseFailure (length s - fromIntegral pos + 1) (nub msgs)) fromResultList _ (ResultList rl _failure) = Right (f <$> toList rl)    where f (ResultInfo _ ((s, _):_) r) = (s, r)
src/Text/Grampa/ContextFree/Parallel.hs view
@@ -40,7 +40,7 @@  data ResultList s r = ResultList !(BinTree (ResultInfo s r)) {-# UNPACK #-} !FailureInfo data ResultInfo s r = ResultInfo !s !r-data FailureInfo = FailureInfo !Int Int [String] deriving (Eq, Show)+data FailureInfo = FailureInfo Int [String] deriving (Eq, Show)  instance (Show s, Show r) => Show (ResultList s r) where    show (ResultList l f) = "ResultList (" ++ shows l (") (" ++ shows f ")")@@ -66,16 +66,13 @@    mappend = (<>)  instance Semigroup FailureInfo where-   f1@(FailureInfo s1 pos1 exp1) <> f2@(FailureInfo s2 pos2 exp2)-      | s1 < s2 = f2-      | s1 > s2 = f1-      | otherwise = FailureInfo s1 pos' exp'+   FailureInfo pos1 exp1 <> FailureInfo pos2 exp2 = FailureInfo pos' exp'       where (pos', exp') | pos1 < pos2 = (pos1, exp1)                          | pos1 > pos2 = (pos2, exp2)                          | otherwise = (pos1, exp1 <> exp2)  instance Monoid FailureInfo where-   mempty = FailureInfo 0 maxBound []+   mempty = FailureInfo maxBound []    mappend = (<>)  instance Functor (Parser g s) where@@ -90,7 +87,7 @@   instance FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\s-> ResultList mempty $ FailureInfo 0 (Factorial.length s) ["empty"])+   empty = Parser (\s-> ResultList mempty $ FailureInfo (Factorial.length s) ["empty"])    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest @@ -130,36 +127,36 @@ instance MonoidParsing (Parser g) where    endOfInput = Parser f       where f s | null s = ResultList (Leaf $ ResultInfo s ()) mempty-                | otherwise = ResultList mempty (FailureInfo 1 (Factorial.length s) ["endOfInput"])+                | otherwise = ResultList mempty (FailureInfo (Factorial.length s) ["endOfInput"])    getInput = Parser p       where p s = ResultList (Leaf $ ResultInfo mempty s) mempty    anyToken = Parser p       where p s = case Factorial.splitPrimePrefix s                   of Just (first, rest) -> ResultList (Leaf $ ResultInfo rest first) mempty-                     _ -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["anyToken"])+                     _ -> ResultList mempty (FailureInfo (Factorial.length s) ["anyToken"])    satisfy predicate = Parser p       where p s = case Factorial.splitPrimePrefix s                   of Just (first, rest) | predicate first -> ResultList (Leaf $ ResultInfo rest first) mempty-                     _ -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["satisfy"])+                     _ -> ResultList mempty (FailureInfo (Factorial.length s) ["satisfy"])    satisfyChar predicate = Parser p       where p s =                case Textual.splitCharacterPrefix s                of Just (first, rest) | predicate first -> ResultList (Leaf $ ResultInfo rest first) mempty-                  _ -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["satisfyChar"])+                  _ -> ResultList mempty (FailureInfo (Factorial.length s) ["satisfyChar"])    satisfyCharInput predicate = Parser p       where p s =                case Textual.splitCharacterPrefix s                of Just (first, rest) | predicate first -> ResultList (Leaf $ ResultInfo rest $ Factorial.primePrefix s) mempty-                  _ -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["satisfyChar"])+                  _ -> ResultList mempty (FailureInfo (Factorial.length s) ["satisfyChar"])    notSatisfy predicate = Parser p       where p s = case Factorial.splitPrimePrefix s                   of Just (first, _) -                        | predicate first -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["notSatisfy"])+                        | predicate first -> ResultList mempty (FailureInfo (Factorial.length s) ["notSatisfy"])                      _ -> ResultList (Leaf $ ResultInfo s ()) mempty    notSatisfyChar predicate = Parser p       where p s = case Textual.characterPrefix s                   of Just first -                        | predicate first -> ResultList mempty (FailureInfo 1 (Factorial.length s) ["notSatisfyChar"])+                        | predicate first -> ResultList mempty (FailureInfo (Factorial.length s) ["notSatisfyChar"])                      _ -> ResultList (Leaf $ ResultInfo s ()) mempty    scan s0 f = Parser (p s0)       where p s i = ResultList (Leaf $ ResultInfo suffix prefix) mempty@@ -172,7 +169,7 @@    takeWhile1 predicate = Parser p       where p s | (prefix, suffix) <- Factorial.span predicate s =                 if Null.null prefix-               then ResultList mempty (FailureInfo 1 (Factorial.length s) ["takeWhile1"])+               then ResultList mempty (FailureInfo (Factorial.length s) ["takeWhile1"])                else ResultList (Leaf $ ResultInfo suffix prefix) mempty    takeCharsWhile predicate = Parser p       where p s | (prefix, suffix) <- Textual.span_ False predicate s = @@ -180,27 +177,33 @@    takeCharsWhile1 predicate = Parser p       where p s | (prefix, suffix) <- Textual.span_ False predicate s =                if null prefix-               then ResultList mempty (FailureInfo 1 (Factorial.length s) ["takeCharsWhile1"])+               then ResultList mempty (FailureInfo (Factorial.length s) ["takeCharsWhile1"])                else ResultList (Leaf $ ResultInfo suffix prefix) mempty    string s = Parser p where       p s' | Just suffix <- Cancellative.stripPrefix s s' = ResultList (Leaf $ ResultInfo suffix s) mempty-           | otherwise = ResultList mempty (FailureInfo 1 (Factorial.length s') ["string " ++ show s])+           | otherwise = ResultList mempty (FailureInfo (Factorial.length s') ["string " ++ show s])    concatMany (Parser p) = Parser q       where q s = ResultList (Leaf $ ResultInfo s mempty) failure <> foldMap continue rs                where ResultList rs failure = p s             continue (ResultInfo suffix prefix) = mappend prefix <$> q suffix  instance FactorialMonoid s => Parsing (Parser g s) where-   try (Parser p) = Parser (weakenResults . p)-      where weakenResults (ResultList rl (FailureInfo s pos msgs)) = ResultList rl (FailureInfo (pred s) pos msgs)-   Parser p <?> msg  = Parser (strengthenResults . p)-      where strengthenResults (ResultList rl (FailureInfo s pos _msgs)) = ResultList rl (FailureInfo (succ s) pos [msg])+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (ResultList rl (FailureInfo _pos _msgs)) =+                        ResultList rl (FailureInfo (fromIntegral $ Factorial.length rest) [])+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (ResultList EmptyTree (FailureInfo pos msgs)) =+                        ResultList EmptyTree (FailureInfo pos $+                                              if pos == fromIntegral (Factorial.length rest) then [msg] else msgs)+                     replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList EmptyTree _) = ResultList (Leaf $ ResultInfo t ()) mempty-            rewind t ResultList{} = ResultList mempty (FailureInfo 1 (Factorial.length t) ["notFollowedBy"])+            rewind t ResultList{} = ResultList mempty (FailureInfo (Factorial.length t) ["notFollowedBy"])    skipMany p = go       where go = pure () <|> p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo 0 (Factorial.length t) [msg])+   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo (Factorial.length t) [msg])    eof = endOfInput  instance FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -222,7 +225,7 @@    token = lexicalToken  fromResultList :: FactorialMonoid s => s -> ResultList s r -> ParseResults [(s, r)]-fromResultList s (ResultList EmptyTree (FailureInfo _ pos msgs)) = +fromResultList s (ResultList EmptyTree (FailureInfo pos msgs)) =     Left (ParseFailure (Factorial.length s - pos) (nub msgs)) fromResultList _ (ResultList rl _failure) = Right (f <$> toList rl)    where f (ResultInfo s r) = (s, r)
src/Text/Grampa/ContextFree/SortedMemoizing.hs view
@@ -57,7 +57,7 @@    {-# INLINABLE (<*>) #-}  instance Alternative (Parser g i) where-   empty = Parser (\rest-> ResultList mempty $ FailureInfo 0 (genericLength rest) ["empty"])+   empty = Parser (\rest-> ResultList mempty $ FailureInfo (genericLength rest) ["empty"])    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest    {-# INLINABLE (<|>) #-}@@ -94,7 +94,7 @@    type GrammarFunctor Parser = ResultList    nonTerminal f = Parser p where       p ((_, d) : _) = f d-      p _ = ResultList mempty (FailureInfo 1 0 ["NonTerminal at endOfInput"])+      p _ = ResultList mempty (FailureInfo 0 ["NonTerminal at endOfInput"])    {-# INLINE nonTerminal #-}  -- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left@@ -133,26 +133,26 @@    anyToken = Parser p       where p rest@((s, _):t) = case splitPrimePrefix s                                 of Just (first, _) -> ResultList [ResultsOfLength 1 t (first:|[])] mempty-                                   _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["anyToken"])-            p [] = ResultList mempty (FailureInfo 1 0 ["anyToken"])+                                   _ -> ResultList mempty (FailureInfo (genericLength rest) ["anyToken"])+            p [] = ResultList mempty (FailureInfo 0 ["anyToken"])    satisfy predicate = Parser p       where p rest@((s, _):t) =                case splitPrimePrefix s                of Just (first, _) | predicate first -> ResultList [ResultsOfLength 1 t (first:|[])] mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfy"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfy"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfy"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfy"])    satisfyChar predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> ResultList [ResultsOfLength 1 t (first:|[])] mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyChar"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyChar"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfyChar"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfyChar"])    satisfyCharInput predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> ResultList [ResultsOfLength 1 t (Factorial.primePrefix s:|[])] mempty-                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyCharInput"])-            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyCharInput"])+                  _ -> ResultList mempty (FailureInfo (genericLength rest) ["satisfyCharInput"])+            p [] = ResultList mempty (FailureInfo 0 ["satisfyCharInput"])    scan s0 f = Parser (p s0)       where p s rest@((i, _) : _) = ResultList [ResultsOfLength l (drop l rest) (prefix:|[])] mempty                where (prefix, _, _) = Factorial.spanMaybe' s f i@@ -172,7 +172,7 @@       where p rest@((s, _) : _)                | x <- Factorial.takeWhile predicate s, l <- Factorial.length x, l > 0 =                     ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty-            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeWhile1"])+            p rest = ResultList mempty (FailureInfo (genericLength rest) ["takeWhile1"])    takeCharsWhile predicate = Parser p       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x =@@ -182,41 +182,44 @@       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x, l > 0 =                     ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty-            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeCharsWhile1"])+            p rest = ResultList mempty (FailureInfo (genericLength rest) ["takeCharsWhile1"])    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = ResultList [ResultsOfLength l (Factorial.drop l rest) (s:|[])] mempty-      p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["string " ++ show s])+      p rest = ResultList mempty (FailureInfo (genericLength rest) ["string " ++ show s])       l = Factorial.length s-   concatMany p = go-      where go = mempty <|> mappend <$> p <*> go    notSatisfy predicate = Parser p       where p rest@((s, _):_)                | Just (first, _) <- splitPrimePrefix s, -                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfy"])+                 predicate first = ResultList mempty (FailureInfo (genericLength rest) ["notSatisfy"])             p rest = ResultList [ResultsOfLength 0 rest (():|[])] mempty    notSatisfyChar predicate = Parser p       where p rest@((s, _):_)                | Just first <- Textual.characterPrefix s, -                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfyChar"])+                 predicate first = ResultList mempty (FailureInfo (genericLength rest) ["notSatisfyChar"])             p rest = ResultList [ResultsOfLength 0 rest (():|[])] mempty    {-# INLINABLE string #-}  instance MonoidNull s => Parsing (Parser g s) where-   try (Parser p) = Parser (weakenResults . p)-      where weakenResults (ResultList rl (FailureInfo s pos msgs)) = ResultList rl (FailureInfo (pred s) pos msgs)-   Parser p <?> msg  = Parser (strengthenResults . p)-      where strengthenResults (ResultList rl (FailureInfo s pos _msgs)) = ResultList rl (FailureInfo (succ s) pos [msg])+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (ResultList rl (FailureInfo _pos _msgs)) =+                        ResultList rl (FailureInfo (genericLength rest) [])+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (ResultList [] (FailureInfo pos msgs)) =+                        ResultList [] (FailureInfo pos $ if pos == genericLength rest then [msg] else msgs)+                     replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList [] _) = ResultList [ResultsOfLength 0 t (():|[])] mempty-            rewind t ResultList{} = ResultList mempty (FailureInfo 1 (genericLength t) ["notFollowedBy"])+            rewind t ResultList{} = ResultList mempty (FailureInfo (genericLength t) ["notFollowedBy"])    skipMany p = go       where go = pure () <|> p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo 0 (genericLength t) [msg])+   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo (genericLength t) [msg])    eof = Parser f       where f rest@((s, _):_)                | null s = ResultList [ResultsOfLength 0 rest (():|[])] mempty-               | otherwise = ResultList mempty (FailureInfo 1 (genericLength rest) ["endOfInput"])+               | otherwise = ResultList mempty (FailureInfo (genericLength rest) ["endOfInput"])             f [] = ResultList [ResultsOfLength 0 [] (():|[])] mempty  instance MonoidNull s => LookAheadParsing (Parser g s) where
src/Text/Grampa/Internal.hs view
@@ -14,7 +14,7 @@  import Prelude hiding (length, showList) -data FailureInfo = FailureInfo !Int Word64 [String] deriving (Eq, Show)+data FailureInfo = FailureInfo Word64 [String] deriving (Eq, Show)  data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] !(NonEmpty r) @@ -26,23 +26,20 @@                deriving (Show)  fromResultList :: FactorialMonoid s => s -> ResultList g s r -> ParseResults [(s, r)]-fromResultList s (ResultList [] (FailureInfo _ pos msgs)) =+fromResultList s (ResultList [] (FailureInfo pos msgs)) =    Left (ParseFailure (length s - fromIntegral pos + 1) (nub msgs)) fromResultList _ (ResultList rl _failure) = Right (foldMap f rl)    where f (ResultsOfLength _ ((s, _):_) r) = (,) s <$> toList r          f (ResultsOfLength _ [] r) = (,) mempty <$> toList r  instance Semigroup FailureInfo where-   f1@(FailureInfo s1 pos1 exp1) <> f2@(FailureInfo s2 pos2 exp2)-      | s1 < s2 = f2-      | s1 > s2 = f1-      | otherwise = FailureInfo s1 pos' exp'+   f1@(FailureInfo pos1 exp1) <> f2@(FailureInfo pos2 exp2) = FailureInfo pos' exp'       where (pos', exp') | pos1 < pos2 = (pos1, exp1)                          | pos1 > pos2 = (pos2, exp2)                          | otherwise = (pos1, exp1 <> exp2)  instance Monoid FailureInfo where-   mempty = FailureInfo 0 maxBound []+   mempty = FailureInfo maxBound []    mappend = (<>)  instance Show r => Show (ResultList g s r) where
src/Text/Grampa/PEG/Backtrack.hs view
@@ -59,7 +59,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest-> NoParse $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -88,12 +88,20 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (NoParse (FailureInfo _pos _msgs)) =+                        NoParse (FailureInfo (fromIntegral $ Factorial.length rest) [])+                     rewindFailure parsed = parsed+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (NoParse (FailureInfo pos msgs)) =+                        NoParse (FailureInfo pos $ if pos == fromIntegral (Factorial.length rest) then [msg] else msgs)+                     replaceFailure parsed = parsed    eof = endOfInput-   unexpected msg = Parser (\t-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t-> NoParse $ FailureInfo (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"])+      where rewind t Parsed{} = NoParse (FailureInfo (fromIntegral $ Factorial.length t) ["notFollowedBy"])             rewind t NoParse{} = Parsed () t  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -118,37 +126,37 @@    endOfInput = Parser p       where p rest                | Null.null rest = Parsed () rest-               | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["endOfInput"])    getInput = Parser p       where p rest = Parsed rest mempty    anyToken = Parser p       where p rest = case Factorial.splitPrimePrefix rest                      of Just (first, suffix) -> Parsed first suffix-                        _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["anyToken"])+                        _ -> NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["anyToken"])    satisfy predicate = Parser p       where p rest =                case Factorial.splitPrimePrefix rest                of Just (first, suffix) | predicate first -> Parsed first suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfy"])+                  _ -> NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["satisfy"])    satisfyChar predicate = Parser p       where p rest =                case Textual.splitCharacterPrefix rest                of Just (first, suffix) | predicate first -> Parsed first suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+                  _ -> NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["satisfyChar"])    satisfyCharInput predicate = Parser p       where p rest =                case Textual.splitCharacterPrefix rest                of Just (first, suffix) | predicate first -> Parsed (Factorial.primePrefix rest) suffix-                  _ -> NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["satisfyChar"])+                  _ -> NoParse (FailureInfo (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"])+                        | predicate first -> NoParse (FailureInfo (fromIntegral $ Factorial.length s) ["notSatisfy"])                      _ -> Parsed () 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"])+                                  -> NoParse (FailureInfo (fromIntegral $ Factorial.length s) ["notSatisfyChar"])                      _ -> Parsed () s    scan s0 f = Parser (p s0)       where p s rest = Parsed prefix suffix@@ -161,18 +169,18 @@    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"])+                        then NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["takeWhile1"])                         else Parsed prefix suffix    takeCharsWhile predicate = Parser p       where p rest | (prefix, suffix) <- Textual.span_ False predicate rest = Parsed 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"])+                     then NoParse (FailureInfo (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])                      else Parsed prefix suffix    string s = Parser p where       p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed s suffix-           | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])+           | otherwise = NoParse (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])    concatMany (Parser p) = Parser q       where q rest = case p rest                      of Parsed prefix suffix -> let Parsed prefix' suffix' = q suffix@@ -195,6 +203,6 @@                                       (Rank2.fmap (<* endOfInput) g)  fromResult :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)-fromResult s (NoParse (FailureInfo _ pos msgs)) =+fromResult s (NoParse (FailureInfo pos msgs)) =    Left (ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)) fromResult _ (Parsed prefix suffix) = Right (suffix, prefix)
src/Text/Grampa/PEG/Backtrack/Measured.hs view
@@ -62,7 +62,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest-> NoParse $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -93,12 +93,20 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (NoParse (FailureInfo _pos _msgs)) =+                        NoParse (FailureInfo (fromIntegral $ Factorial.length rest) [])+                     rewindFailure parsed = parsed+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (NoParse (FailureInfo pos msgs)) =+                        NoParse (FailureInfo pos $ if pos == fromIntegral (Factorial.length rest) then [msg] else msgs)+                     replaceFailure parsed = parsed    eof = endOfInput-   unexpected msg = Parser (\t-> NoParse $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t-> NoParse $ FailureInfo (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"])+      where rewind t Parsed{} = NoParse (FailureInfo (fromIntegral $ Factorial.length t) ["notFollowedBy"])             rewind t NoParse{} = Parsed 0 () t  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -123,37 +131,37 @@    endOfInput = Parser p       where p rest                | Null.null rest = Parsed 0 () rest-               | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = NoParse (FailureInfo (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"])+                        _ -> NoParse (FailureInfo (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"])+                  _ -> NoParse (FailureInfo (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"])+                  _ -> NoParse (FailureInfo (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"])+                  _ -> NoParse (FailureInfo (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"])+                        | predicate first -> NoParse (FailureInfo (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"])+                                  -> NoParse (FailureInfo (fromIntegral $ Factorial.length s) ["notSatisfyChar"])                      _ -> Parsed 0 () s    scan s0 f = Parser (p s0)       where p s rest = Parsed (Factorial.length prefix) prefix suffix@@ -167,7 +175,7 @@    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"])+                        then NoParse (FailureInfo (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 = @@ -175,11 +183,11 @@    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"])+                     then NoParse (FailureInfo (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])+           | otherwise = NoParse (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])       l = Factorial.length s    concatMany (Parser p) = Parser q       where q rest = case p rest@@ -203,6 +211,6 @@                                       (Rank2.fmap (<* endOfInput) g)  fromResult :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)-fromResult s (NoParse (FailureInfo _ pos msgs)) =+fromResult s (NoParse (FailureInfo pos msgs)) =    Left (ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)) fromResult _ (Parsed _ prefix suffix) = Right (suffix, prefix)
src/Text/Grampa/PEG/Continued.hs view
@@ -60,7 +60,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest _ failure-> failure $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -88,14 +88,23 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try :: forall a. Parser g s a -> Parser g s a+   try (Parser p) = Parser q+      where q :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . rewindFailure)+               where rewindFailure (FailureInfo _pos _msgs) = FailureInfo (fromIntegral $ Factorial.length input) []+   (<?>) :: forall a. Parser g s a -> String -> Parser g s a+   Parser p <?> msg  = Parser q+      where q :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . replaceFailure)+               where replaceFailure (FailureInfo pos msgs) =+                        FailureInfo pos (if pos == fromIntegral (Factorial.length input) then [msg] else msgs)    eof = endOfInput-   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo (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"])+               where success' _ _ = failure (FailureInfo (fromIntegral $ Factorial.length input) ["notFollowedBy"])                      failure' _ = success () input  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -123,42 +132,42 @@    endOfInput = Parser p       where p rest success failure                | Null.null rest = success () rest-               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                     | predicate first -> failure (FailureInfo (fromIntegral $ Factorial.length rest) ["notSatisfy"])                   _ -> success () rest    notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()    notSatisfyChar predicate = Parser p@@ -166,7 +175,7 @@             p rest success failure =                case Textual.characterPrefix rest                of Just first | predicate first-                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                               -> failure (FailureInfo (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)@@ -188,7 +197,7 @@             p rest success failure                | (prefix, suffix) <- Factorial.span predicate rest =                     if Null.null prefix-                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    then failure (FailureInfo (fromIntegral $ Factorial.length rest) ["takeWhile1"])                     else success prefix suffix    takeCharsWhile :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s s    takeCharsWhile predicate = Parser p@@ -198,7 +207,7 @@    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"])+               | Null.null prefix = failure (FailureInfo (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@@ -206,7 +215,7 @@       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])+         | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])    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@@ -229,4 +238,4 @@                                       (Rank2.fmap (<* endOfInput) g)  fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure-fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)+fromFailure s (FailureInfo pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)
src/Text/Grampa/PEG/Continued/Measured.hs view
@@ -61,7 +61,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ FailureInfo 0 (fromIntegral $ Factorial.length rest) ["empty"])+   empty = Parser (\rest _ failure-> failure $ FailureInfo (fromIntegral $ Factorial.length rest) ["empty"])    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -91,14 +91,23 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try :: forall a. Parser g s a -> Parser g s a+   try (Parser p) = Parser q+      where q :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . rewindFailure)+               where rewindFailure (FailureInfo _pos _msgs) = FailureInfo (fromIntegral $ Factorial.length input) []+   (<?>) :: forall a. Parser g s a -> String -> Parser g s a+   Parser p <?> msg  = Parser q+      where q :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x+            q input success failure = p input success (failure . replaceFailure)+               where replaceFailure (FailureInfo pos msgs) =+                        FailureInfo pos (if pos == fromIntegral (Factorial.length input) then [msg] else msgs)    eof = endOfInput-   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo 0 (fromIntegral $ Factorial.length t) [msg])+   unexpected msg = Parser (\t _ failure -> failure $ FailureInfo (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"])+               where success' _ _ _ = failure (FailureInfo (fromIntegral $ Factorial.length input) ["notFollowedBy"])                      failure' _ = success () 0 input  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -126,7 +135,7 @@    endOfInput = Parser p       where p rest success failure                | Null.null rest = success () 0 rest-               | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["endOfInput"])+               | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length rest) ["endOfInput"])    getInput = Parser p       where p rest success _ = success rest len mempty                where !len = Factorial.length rest@@ -134,35 +143,35 @@       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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                  _ -> failure (FailureInfo (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"])+                     | predicate first -> failure (FailureInfo (fromIntegral $ Factorial.length rest) ["notSatisfy"])                   _ -> success () 0 rest    notSatisfyChar :: forall s. TextualMonoid s => (Char -> Bool) -> Parser g s ()    notSatisfyChar predicate = Parser p@@ -170,7 +179,7 @@             p rest success failure =                case Textual.characterPrefix rest                of Just first | predicate first-                               -> failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["notSatisfyChar"])+                               -> failure (FailureInfo (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)@@ -197,7 +206,7 @@                | (prefix, suffix) <- Factorial.span predicate rest,                   !len <- Factorial.length prefix =                     if len == 0-                    then failure (FailureInfo 1 (fromIntegral $ Factorial.length rest) ["takeWhile1"])+                    then failure (FailureInfo (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@@ -209,7 +218,7 @@    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"])+               | Null.null prefix = failure (FailureInfo (fromIntegral $ Factorial.length rest) ["takeCharsWhile1"])                | otherwise = success prefix len suffix                where (prefix, suffix) = Textual.span_ False predicate rest                      !len = Factorial.length prefix@@ -218,7 +227,7 @@       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])+         | otherwise = failure (FailureInfo (fromIntegral $ Factorial.length s') ["string " ++ show s])    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@@ -244,4 +253,4 @@                                       (Rank2.fmap (<* endOfInput) g)  fromFailure :: FactorialMonoid s => s -> FailureInfo -> ParseFailure-fromFailure s (FailureInfo _ pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)+fromFailure s (FailureInfo pos msgs) = ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)
src/Text/Grampa/PEG/Packrat.hs view
@@ -60,7 +60,7 @@                   NoParse failure -> NoParse failure  instance Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ FailureInfo 0 (genericLength rest) ["empty"])+   empty = Parser (\rest-> NoParse $ FailureInfo (genericLength rest) ["empty"])    Parser p <|> Parser q = Parser r where       r rest = case p rest                of x@Parsed{} -> x@@ -85,12 +85,19 @@    mappend = liftA2 mappend  instance Factorial.FactorialMonoid s => Parsing (Parser g s) where-   try = id-   (<?>) = const+   try (Parser p) = Parser q+      where q rest = rewindFailure (p rest)+               where rewindFailure (NoParse (FailureInfo _pos _msgs)) = NoParse (FailureInfo (genericLength rest) [])+                     rewindFailure parsed = parsed+   Parser p <?> msg  = Parser q+      where q rest = replaceFailure (p rest)+               where replaceFailure (NoParse (FailureInfo pos msgs)) =+                        NoParse (FailureInfo pos $ if pos == genericLength rest then [msg] else msgs)+                     replaceFailure parsed = parsed    eof = endOfInput-   unexpected msg = Parser (\t-> NoParse $ FailureInfo 0 (genericLength t) [msg])+   unexpected msg = Parser (\t-> NoParse $ FailureInfo (genericLength t) [msg])    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))-      where rewind t Parsed{} = NoParse (FailureInfo 1 (genericLength t) ["notFollowedBy"])+      where rewind t Parsed{} = NoParse (FailureInfo (genericLength t) ["notFollowedBy"])             rewind t NoParse{} = Parsed () t  instance Factorial.FactorialMonoid s => LookAheadParsing (Parser g s) where@@ -115,12 +122,12 @@    type GrammarFunctor Parser = Result    nonTerminal f = Parser p where       p ((_, d) : _) = f d-      p _ = NoParse (FailureInfo 1 0 ["NonTerminal at endOfInput"])+      p _ = NoParse (FailureInfo 0 ["NonTerminal at endOfInput"])  instance MonoidParsing (Parser g) where    endOfInput = Parser p       where p rest@((s, _) : _)-               | not (Null.null s) = NoParse (FailureInfo 1 (genericLength rest) ["endOfInput"])+               | not (Null.null s) = NoParse (FailureInfo (genericLength rest) ["endOfInput"])             p rest = Parsed () rest    getInput = Parser p       where p rest@((s, _):_) = Parsed s [last rest]@@ -128,35 +135,35 @@    anyToken = Parser p       where p rest@((s, _):t) = case Factorial.splitPrimePrefix s                                 of Just (first, _) -> Parsed first t-                                   _ -> NoParse (FailureInfo 1 (genericLength rest) ["anyToken"])-            p [] = NoParse (FailureInfo 1 0 ["anyToken"])+                                   _ -> NoParse (FailureInfo (genericLength rest) ["anyToken"])+            p [] = NoParse (FailureInfo 0 ["anyToken"])    satisfy predicate = Parser p       where p rest@((s, _):t) =                case Factorial.splitPrimePrefix s                of Just (first, _) | predicate first -> Parsed first t-                  _ -> NoParse (FailureInfo 1 (genericLength rest) ["satisfy"])-            p [] = NoParse (FailureInfo 1 0 ["satisfy"])+                  _ -> NoParse (FailureInfo (genericLength rest) ["satisfy"])+            p [] = NoParse (FailureInfo 0 ["satisfy"])    satisfyChar predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> Parsed first t-                  _ -> NoParse (FailureInfo 1 (genericLength rest) ["satisfyChar"])-            p [] = NoParse (FailureInfo 1 0 ["satisfyChar"])+                  _ -> NoParse (FailureInfo (genericLength rest) ["satisfyChar"])+            p [] = NoParse (FailureInfo 0 ["satisfyChar"])    satisfyCharInput predicate = Parser p       where p rest@((s, _):t) =                case Textual.characterPrefix s                of Just first | predicate first -> Parsed (Factorial.primePrefix s) t-                  _ -> NoParse (FailureInfo 1 (genericLength rest) ["satisfyChar"])-            p [] = NoParse (FailureInfo 1 0 ["satisfyChar"])+                  _ -> NoParse (FailureInfo (genericLength rest) ["satisfyChar"])+            p [] = NoParse (FailureInfo 0 ["satisfyChar"])    notSatisfy predicate = Parser p       where p rest@((s, _):_)                | Just (first, _) <- Factorial.splitPrimePrefix s, -                 predicate first = NoParse (FailureInfo 1 (genericLength rest) ["notSatisfy"])+                 predicate first = NoParse (FailureInfo (genericLength rest) ["notSatisfy"])             p rest = Parsed () rest    notSatisfyChar predicate = Parser p       where p rest@((s, _):_)                | Just first <- Textual.characterPrefix s, -                 predicate first = NoParse (FailureInfo 1 (genericLength rest) ["notSatisfyChar"])+                 predicate first = NoParse (FailureInfo (genericLength rest) ["notSatisfyChar"])             p rest = Parsed () rest    scan s0 f = Parser (p s0)       where p s ((i, _):t) = Parsed prefix (drop (Factorial.length prefix - 1) t)@@ -174,7 +181,7 @@       where p rest@((s, _) : _)                | x <- Factorial.takeWhile predicate s, not (Null.null x) =                     Parsed x (Factorial.drop (Factorial.length x) rest)-            p rest = NoParse (FailureInfo 1 (genericLength rest) ["takeWhile1"])+            p rest = NoParse (FailureInfo (genericLength rest) ["takeWhile1"])    takeCharsWhile predicate = Parser p       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s =@@ -184,11 +191,11 @@       where p rest@((s, _) : _)                | x <- Textual.takeWhile_ False predicate s, not (Null.null x) =                     Parsed x (drop (Factorial.length x) rest)-            p rest = NoParse (FailureInfo 1 (genericLength rest) ["takeCharsWhile1"])+            p rest = NoParse (FailureInfo (genericLength rest) ["takeCharsWhile1"])    string s = Parser p where       p rest@((s', _) : _)          | Cancellative.isPrefixOf s s' = Parsed s (Factorial.drop (Factorial.length s) rest)-      p rest = NoParse (FailureInfo 1 (genericLength rest) ["string " ++ show s])+      p rest = NoParse (FailureInfo (genericLength rest) ["string " ++ show s])    concatMany p = go       where go = mappend <$> p <*> go <|> mempty @@ -219,7 +226,7 @@    where gd = Rank2.fmap (`applyParser` parsed) final  fromResult :: FactorialMonoid s => s -> Result g s r -> ParseResults (s, r)-fromResult s (NoParse (FailureInfo _ pos msgs)) =+fromResult s (NoParse (FailureInfo pos msgs)) =    Left (ParseFailure (Factorial.length s - fromIntegral pos + 1) (nub msgs)) fromResult _ (Parsed prefix []) = Right (mempty, prefix) fromResult _ (Parsed prefix ((s, _):_)) = Right (s, prefix)