diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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.
diff --git a/grammatical-parsers.cabal b/grammatical-parsers.cabal
--- a/grammatical-parsers.cabal
+++ b/grammatical-parsers.cabal
@@ -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,
diff --git a/src/Text/Grampa.hs b/src/Text/Grampa.hs
--- a/src/Text/Grampa.hs
+++ b/src/Text/Grampa.hs
@@ -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
diff --git a/src/Text/Grampa/Class.hs b/src/Text/Grampa/Class.hs
--- a/src/Text/Grampa/Class.hs
+++ b/src/Text/Grampa/Class.hs
@@ -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)
diff --git a/src/Text/Grampa/Combinators.hs b/src/Text/Grampa/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Grampa/Combinators.hs
@@ -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)
diff --git a/src/Text/Grampa/ContextFree/Continued.hs b/src/Text/Grampa/ContextFree/Continued.hs
--- a/src/Text/Grampa/ContextFree/Continued.hs
+++ b/src/Text/Grampa/ContextFree/Continued.hs
@@ -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)
diff --git a/src/Text/Grampa/ContextFree/Continued/Measured.hs b/src/Text/Grampa/ContextFree/Continued/Measured.hs
--- a/src/Text/Grampa/ContextFree/Continued/Measured.hs
+++ b/src/Text/Grampa/ContextFree/Continued/Measured.hs
@@ -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)
diff --git a/src/Text/Grampa/ContextFree/Memoizing.hs b/src/Text/Grampa/ContextFree/Memoizing.hs
--- a/src/Text/Grampa/ContextFree/Memoizing.hs
+++ b/src/Text/Grampa/ContextFree/Memoizing.hs
@@ -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)
diff --git a/src/Text/Grampa/ContextFree/Parallel.hs b/src/Text/Grampa/ContextFree/Parallel.hs
--- a/src/Text/Grampa/ContextFree/Parallel.hs
+++ b/src/Text/Grampa/ContextFree/Parallel.hs
@@ -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)
diff --git a/src/Text/Grampa/ContextFree/SortedMemoizing.hs b/src/Text/Grampa/ContextFree/SortedMemoizing.hs
--- a/src/Text/Grampa/ContextFree/SortedMemoizing.hs
+++ b/src/Text/Grampa/ContextFree/SortedMemoizing.hs
@@ -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
diff --git a/src/Text/Grampa/Internal.hs b/src/Text/Grampa/Internal.hs
--- a/src/Text/Grampa/Internal.hs
+++ b/src/Text/Grampa/Internal.hs
@@ -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
diff --git a/src/Text/Grampa/PEG/Backtrack.hs b/src/Text/Grampa/PEG/Backtrack.hs
--- a/src/Text/Grampa/PEG/Backtrack.hs
+++ b/src/Text/Grampa/PEG/Backtrack.hs
@@ -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)
diff --git a/src/Text/Grampa/PEG/Backtrack/Measured.hs b/src/Text/Grampa/PEG/Backtrack/Measured.hs
--- a/src/Text/Grampa/PEG/Backtrack/Measured.hs
+++ b/src/Text/Grampa/PEG/Backtrack/Measured.hs
@@ -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)
diff --git a/src/Text/Grampa/PEG/Continued.hs b/src/Text/Grampa/PEG/Continued.hs
--- a/src/Text/Grampa/PEG/Continued.hs
+++ b/src/Text/Grampa/PEG/Continued.hs
@@ -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)
diff --git a/src/Text/Grampa/PEG/Continued/Measured.hs b/src/Text/Grampa/PEG/Continued/Measured.hs
--- a/src/Text/Grampa/PEG/Continued/Measured.hs
+++ b/src/Text/Grampa/PEG/Continued/Measured.hs
@@ -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)
diff --git a/src/Text/Grampa/PEG/Packrat.hs b/src/Text/Grampa/PEG/Packrat.hs
--- a/src/Text/Grampa/PEG/Packrat.hs
+++ b/src/Text/Grampa/PEG/Packrat.hs
@@ -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)