diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+The MIT License (MIT)
+
+Copyright (c) 2018 Daniel Mendler
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
diff --git a/example.hs b/example.hs
new file mode 100644
--- /dev/null
+++ b/example.hs
@@ -0,0 +1,60 @@
+
+import System.Environment (getArgs)
+import Text.PariPari
+import qualified Data.ByteString as B
+
+data Value
+  = Object ![(Text, Value)]
+  | Array  ![Value]
+  | String !Text
+  | Number !Integer !Integer
+  | Bool   !Bool
+  | Null
+  deriving (Eq, Show)
+
+json :: Parser Value
+json = space *> (object <|> array) <?> "json"
+
+object :: Parser Value
+object = Object <$> (char '{' *> space *> sepBy pair (space *> char ',' *> space) <* space <* char '}') <?> "object"
+
+pair :: Parser (Text, Value)
+pair = (,) <$> (text <* space) <*> (char ':' *> space *> value)
+
+array :: Parser Value
+array = Array <$> (char '[' *> sepBy value (space *> char ',' *> space) <* space <* char ']') <?> "array"
+
+value :: Parser Value
+value =
+  (String <$> text)
+    <|> object
+    <|> array
+    <|> (Bool False <$ string "false")
+    <|> (Bool True  <$ string "true")
+    <|> (Null       <$ string "null")
+    <|> number
+
+text :: Parser Text
+text = char '"' *> takeCharsWhile (/= '"') <* char '"' <?> "text"
+
+number :: Parser Value
+number = label "number" $ do
+  neg <- option id $ negate <$ char '-'
+  (c, _, e) <- fractionDec (pure ())
+  pure $ Number (neg c) e
+
+space :: Parser ()
+space = skipCharsWhile (\c -> c == ' ' || c == '\n' || c == '\t')
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    [file] -> do
+      b <- B.readFile file
+      case runParser json file b of
+        Left x  -> do
+          putStrLn $ showReport x
+          print $ runTracer json file b
+        Right x -> print x
+    _ -> error "Usage: example test.json"
diff --git a/paripari.cabal b/paripari.cabal
new file mode 100644
--- /dev/null
+++ b/paripari.cabal
@@ -0,0 +1,62 @@
+-- This file has been generated from package.yaml by hpack version 0.28.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 35567a9d1dd99ccd046b88ea5fd4cf74ce38d5bb58560bb7f1b3450ff1a1fbbe
+
+name:           paripari
+version:        0.1.0.0
+synopsis:       Fast-path parser combinators with fallback for error reporting
+description:    PariPari offers two parsing strategies. There is a fast Acceptor and a slower Reporter which are evaluated in parallel. If the Acceptor fails, the Reporter returns a report about the parsing errors. Unlike Parsec and like Attoparsec, the parser combinators backtrack by default.
+category:       Text
+stability:      experimental
+homepage:       https://github.com/minad/paripari#readme
+bug-reports:    https://github.com/minad/paripari/issues
+author:         Daniel Mendler <mail@daniel-mendler.de>
+maintainer:     Daniel Mendler <mail@daniel-mendler.de>
+copyright:      2018 Daniel Mendler
+license:        MIT
+license-file:   LICENSE
+tested-with:    GHC == 8.4.3, GHC == 8.6.1
+build-type:     Simple
+cabal-version:  >= 1.10
+
+source-repository head
+  type: git
+  location: https://github.com/minad/paripari
+
+library
+  exposed-modules:
+      Text.PariPari
+      Text.PariPari.Acceptor
+      Text.PariPari.Ascii
+      Text.PariPari.Class
+      Text.PariPari.Combinators
+      Text.PariPari.Decode
+      Text.PariPari.Reporter
+  other-modules:
+      Paths_paripari
+  hs-source-dirs:
+      src
+  default-extensions: BangPatterns DeriveGeneric GeneralizedNewtypeDeriving MultiWayIf NamedFieldPuns OverloadedStrings Rank2Types
+  ghc-options: -Wall -Widentities -Wmonomorphism-restriction -Wincomplete-uni-patterns -Wincomplete-record-updates -Wtabs -fprint-potential-instances
+  build-depends:
+      base >=4.8 && <5
+    , bytestring >=0.10 && <0.11
+    , parser-combinators >=1.0 && <1.1
+    , text >=0.11 && <1.3
+  default-language: Haskell2010
+
+executable example
+  main-is: example.hs
+  other-modules:
+      Paths_paripari
+  default-extensions: BangPatterns DeriveGeneric GeneralizedNewtypeDeriving MultiWayIf NamedFieldPuns OverloadedStrings Rank2Types
+  ghc-options: -Wall -Widentities -Wmonomorphism-restriction -Wincomplete-uni-patterns -Wincomplete-record-updates -Wtabs -fprint-potential-instances
+  build-depends:
+      base >=4.8 && <5
+    , bytestring >=0.10 && <0.11
+    , paripari
+    , parser-combinators >=1.0 && <1.1
+    , text >=0.11 && <1.3
+  default-language: Haskell2010
diff --git a/src/Text/PariPari.hs b/src/Text/PariPari.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari.hs
@@ -0,0 +1,53 @@
+module Text.PariPari (
+  module Text.PariPari.Class
+  , module Text.PariPari.Combinators
+  , module Text.PariPari.Acceptor
+  , module Text.PariPari.Reporter
+  , runParser
+  , runSeqParser
+  , runParserWithOptions
+  , runSeqParserWithOptions
+) where
+
+import Text.PariPari.Acceptor
+import Text.PariPari.Class
+import Text.PariPari.Combinators
+import Text.PariPari.Reporter
+import GHC.Conc (par)
+
+-- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **in parallel**.
+-- The 'FilePath' is used for error reporting.
+-- When the acceptor does not return successfully, the result from the reporter
+-- is awaited.
+runParser :: Parser a -> FilePath -> ByteString -> Either Report a
+runParser = runParserWithOptions defaultReportOptions
+{-# INLINE runParser #-}
+-- Inline to force the specializer to kick in
+
+-- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **sequentially**.
+-- The 'FilePath' is used for error reporting.
+-- When the acceptor does not return successfully, the result from the reporter
+-- is awaited.
+runSeqParser :: Parser a -> FilePath -> ByteString -> Either Report a
+runSeqParser = runSeqParserWithOptions defaultReportOptions
+{-# INLINE runSeqParser #-}
+
+-- | Run parsers **in parallel** with additional 'ReportOptions'.
+runParserWithOptions :: ReportOptions -> Parser a -> FilePath -> ByteString -> Either Report a
+runParserWithOptions o p f b =
+  let a = runAcceptor p f b
+      r = runReporterWithOptions o p f b
+  in case r `par` a of
+       Left _  -> r
+       Right x -> Right x
+{-# INLINE runParserWithOptions #-}
+
+-- | Run parsers **sequentially** with additional 'ReportOptions'.
+runSeqParserWithOptions :: ReportOptions -> Parser a -> FilePath -> ByteString -> Either Report a
+runSeqParserWithOptions o p f b =
+  let a = runAcceptor p f b
+      r = runReporterWithOptions o p f b
+  in case a of
+       Left _  -> r
+       Right x -> Right x
+{-# INLINE runSeqParserWithOptions #-}
diff --git a/src/Text/PariPari/Acceptor.hs b/src/Text/PariPari/Acceptor.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Acceptor.hs
@@ -0,0 +1,242 @@
+module Text.PariPari.Acceptor (
+  Acceptor
+  , runAcceptor
+) where
+
+import Control.Monad (void)
+import Text.PariPari.Ascii
+import Text.PariPari.Class
+import Text.PariPari.Decode
+import Foreign.ForeignPtr (ForeignPtr)
+import qualified Control.Monad.Fail as Fail
+import qualified Data.ByteString.Internal as B
+
+data Env = Env
+  { _envSrc     :: !(ForeignPtr Word8)
+  , _envEnd     :: !Int
+  , _envFile    :: !FilePath
+  , _envRefLine :: !Int
+  , _envRefCol  :: !Int
+  }
+
+data State = State
+  { _stOff     :: !Int
+  , _stLine    :: !Int
+  , _stCol     :: !Int
+  }
+
+-- | Parser which is optimized for fast parsing. Error reporting
+-- is minimal.
+newtype Acceptor a = Acceptor
+  { unAcceptor :: forall b. Env -> State
+               -> (a     -> State -> b)
+               -> (Error -> b)
+               -> b
+  }
+
+instance Semigroup a => Semigroup (Acceptor a) where
+  p1 <> p2 = (<>) <$> p1 <*> p2
+  {-# INLINE (<>) #-}
+
+instance Monoid a => Monoid (Acceptor a) where
+  mempty = pure mempty
+  {-# INLINE mempty #-}
+
+instance Functor Acceptor where
+  fmap f p = Acceptor $ \env st ok err ->
+    unAcceptor p env st (ok . f) err
+  {-# INLINE fmap #-}
+
+instance Applicative Acceptor where
+  pure x = Acceptor $ \_ st ok _ -> ok x st
+  {-# INLINE pure #-}
+
+  f <*> a = Acceptor $ \env st ok err ->
+    let ok1 f' s =
+          let ok2 a' s' = ok (f' a') s'
+          in unAcceptor a env s ok2 err
+    in unAcceptor f env st ok1 err
+  {-# INLINE (<*>) #-}
+
+  p1 *> p2 = do
+    void p1
+    p2
+  {-# INLINE (*>) #-}
+
+  p1 <* p2 = do
+    x <- p1
+    void p2
+    pure x
+  {-# INLINE (<*) #-}
+
+instance Alternative Acceptor where
+  empty = Acceptor $ \_ _ _ err -> err EEmpty
+  {-# INLINE empty #-}
+
+  p1 <|> p2 = Acceptor $ \env st ok err ->
+    let err' _ = unAcceptor p2 env st ok err
+    in unAcceptor p1 env st ok err'
+  {-# INLINE (<|>) #-}
+
+instance MonadPlus Acceptor
+
+instance Monad Acceptor where
+  p >>= f = Acceptor $ \env st ok err ->
+    let ok' x s = unAcceptor (f x) env s ok err
+    in unAcceptor p env st ok' err
+  {-# INLINE (>>=) #-}
+
+  fail msg = Fail.fail msg
+  {-# INLINE fail #-}
+
+instance Fail.MonadFail Acceptor where
+  fail msg = failWith $ EFail msg
+  {-# INLINE fail #-}
+
+instance MonadParser Acceptor where
+  getPos = get $ \_ st -> Pos (_stLine st) (_stCol st)
+  {-# INLINE getPos #-}
+
+  getFile = get $ \env _ -> _envFile env
+  {-# INLINE getFile #-}
+
+  getRefPos = get $ \env _ -> Pos (_envRefLine env) (_envRefCol env)
+  {-# INLINE getRefPos #-}
+
+  withRefPos p = local (\st env -> env { _envRefLine = _stLine st, _envRefCol = _stCol st }) p
+  {-# INLINE withRefPos #-}
+
+  notFollowedBy p = Acceptor $ \env st ok err ->
+    let ok' _ _ = err $ ECombinator "notFollowedBy"
+        err' _ = ok () st
+    in unAcceptor p env st ok' err'
+  {-# INLINE notFollowedBy #-}
+
+  lookAhead p = Acceptor $ \env st ok err ->
+    let ok' x _ = ok x st
+    in unAcceptor p env st ok' err
+  {-# INLINE lookAhead #-}
+
+  failWith e = Acceptor $ \_ _ _ err -> err e
+  {-# INLINE failWith #-}
+
+  eof = Acceptor $ \env st ok err ->
+    if _stOff st >= _envEnd env then
+      ok () st
+    else
+      err EExpectedEnd
+  {-# INLINE eof #-}
+
+  label _ p = p
+  {-# INLINE label #-}
+
+  hidden p = p
+  {-# INLINE hidden #-}
+
+  commit p = p
+  {-# INLINE commit #-}
+
+  byte b = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    if | _stOff >= _envEnd env -> err EEmpty
+       | b == byteAt (_envSrc env) _stOff ->
+           ok b st
+           { _stOff =_stOff + 1
+           , _stLine = if b == asc_newline then _stLine + 1 else _stLine
+           , _stCol = if b == asc_newline then 1 else _stCol + 1
+           }
+       | otherwise ->
+           err $ ECombinator "byte"
+  {-# INLINE byte #-}
+
+  byteSatisfy f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    let b = byteAt (_envSrc env) _stOff
+    in if | _stOff >= _envEnd env -> err EEmpty
+          | f b ->
+              ok b st
+              { _stOff =_stOff + 1
+              , _stLine = if b == asc_newline then _stLine + 1 else _stLine
+              , _stCol = if b == asc_newline then 1 else _stCol + 1
+              }
+          | otherwise ->
+              err $ ECombinator "byteSatisfy"
+  {-# INLINE byteSatisfy #-}
+
+  bytes b@(B.PS p i n) = Acceptor $ \env st@State{_stOff,_stCol} ok err ->
+    if n + _stOff <= _envEnd env &&
+       bytesEqual (_envSrc env) _stOff p i n then
+      ok b st { _stOff = _stOff + n, _stCol = _stCol + n }
+    else
+      err $ ECombinator "bytes"
+  {-# INLINE bytes #-}
+
+  asBytes p = do
+    begin <- get (const _stOff)
+    p
+    end <- get (const _stOff)
+    src <- get (\env _ -> _envSrc env)
+    pure $ B.PS src begin (end - begin)
+  {-# INLINE asBytes #-}
+
+  satisfy f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    let (c, w) = utf8Decode (_envSrc env) _stOff
+    in if | c /= '\0' ->
+            if f c then
+              ok c st
+              { _stOff =_stOff + w
+              , _stLine = if c == '\n' then _stLine + 1 else _stLine
+              , _stCol = if c == '\n' then 1 else _stCol + 1
+              }
+            else
+              err $ ECombinator "satisfy"
+          | c == '\0' && _stOff >= _envEnd env -> err EEmpty
+          | otherwise -> err $ ECombinator "satisfy"
+  {-# INLINE satisfy #-}
+
+  -- By inling this combinator, GHC should figure out the `utf8Width`
+  -- of the character resulting in an optimized decoder.
+  char c =
+    let w = utf8Width c
+    in Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+      if utf8DecodeFixed w (_envSrc env) _stOff == c then
+        ok c st
+        { _stOff =_stOff + w
+        , _stLine = if c == '\n' then _stLine + 1 else _stLine
+        , _stCol = if c == '\n' then 1 else _stCol + 1
+        }
+      else
+        err $ ECombinator "char"
+  {-# INLINE char #-}
+
+-- | Reader monad, get something from the environment
+get :: (Env -> State -> a) -> Acceptor a
+get f = Acceptor $ \env st ok _ -> ok (f env st) st
+{-# INLINE get #-}
+
+-- | Reader monad, modify environment locally
+local :: (State -> Env -> Env) -> Acceptor a -> Acceptor a
+local f p = Acceptor $ \env st ok err ->
+  unAcceptor p (f st env) st ok err
+{-# INLINE local #-}
+
+-- | Run 'Acceptor' on the given 'ByteString', returning either
+-- a simple 'Error' or, if successful, the result.
+runAcceptor :: Acceptor a -> FilePath -> ByteString -> Either Error a
+runAcceptor p f t =
+  let b = t <> "\0\0\0"
+  in unAcceptor p (initialEnv f b) (initialState b) (\x _ -> Right x) Left
+
+initialEnv :: FilePath -> ByteString -> Env
+initialEnv _envFile (B.PS _envSrc off len) = Env
+  { _envSrc
+  , _envFile
+  , _envEnd = off + len - 3
+  , _envRefLine = 0
+  , _envRefCol = 0
+  }
+
+initialState :: ByteString -> State
+initialState (B.PS _ _stOff _) = State
+  { _stOff
+  , _stLine = 1
+  , _stCol = 1
+  }
diff --git a/src/Text/PariPari/Ascii.hs b/src/Text/PariPari/Ascii.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Ascii.hs
@@ -0,0 +1,45 @@
+module Text.PariPari.Ascii (
+  module Text.PariPari.Ascii
+) where
+
+import Data.ByteString (ByteString)
+import Data.Foldable (foldl')
+import Data.Word (Word8)
+import GHC.Base (unsafeChr)
+import GHC.Show (showLitChar)
+import Numeric (showHex)
+import qualified Data.ByteString as B
+
+asc_0, asc_9, asc_A, asc_E, asc_P, asc_a, asc_e, asc_p,
+  asc_minus, asc_plus, asc_point, asc_newline :: Word8
+asc_0 = 48
+asc_9 = 57
+asc_A = 65
+asc_E = 69
+asc_P = 80
+asc_a = 97
+asc_e = 101
+asc_p = 112
+asc_minus = 45
+asc_plus = 43
+asc_point = 46
+asc_newline = 10
+
+unsafeAsciiToChar :: Word8 -> Char
+unsafeAsciiToChar = unsafeChr . fromIntegral
+{-# INLINE unsafeAsciiToChar #-}
+
+byteS :: Word8 -> ShowS
+byteS b
+  | b < 128 = showLitChar $ unsafeAsciiToChar b
+  | otherwise = ("\\x" <>) . showHex b
+
+bytesS :: ByteString -> ShowS
+bytesS b | B.length b == 1 = byteS $ B.head b
+         | otherwise = foldl' ((. byteS) . (.)) id $ B.unpack b
+
+showByte :: Word8 -> String
+showByte b = ('\'':) . byteS b . ('\'':) $ ""
+
+showBytes :: ByteString -> String
+showBytes b = ('"':) . bytesS b . ('"':) $ ""
diff --git a/src/Text/PariPari/Class.hs b/src/Text/PariPari/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Class.hs
@@ -0,0 +1,126 @@
+module Text.PariPari.Class (
+  MonadParser(..)
+  , Parser
+  , Alternative(..)
+  , MonadPlus
+  , Pos(..)
+  , Error(..)
+  , ByteString
+  , Word8
+  , showError
+) where
+
+import Control.Applicative (Alternative(empty, (<|>)))
+import Control.Monad (MonadPlus(..))
+import Control.Monad.Fail (MonadFail(..))
+import Data.ByteString (ByteString)
+import Data.List (intercalate)
+import Data.Word (Word8)
+import GHC.Generics (Generic)
+
+-- | Line and column position starting at (1,1)
+data Pos = Pos
+  { _posLine   :: !Int
+  , _posColumn :: !Int
+  } deriving (Eq, Show, Generic)
+
+-- | Parsing errors
+data Error
+  = EEmpty
+  | EInvalidUtf8
+  | EExpectedEnd
+  | EExpected         [String]
+  | EUnexpected       String
+  | EFail             String
+  | ECombinator       String
+  | EIndentNotAligned !Int !Int
+  | EIndentOverLine   !Int !Int
+  | ENotEnoughIndent  !Int !Int
+  deriving (Eq, Ord, Show, Generic)
+
+-- | Parser shortcut
+type Parser a = (forall p. MonadParser p => p a)
+
+-- | Parser class, which specifies the necessary
+-- primitives for parsing. All other parser combinators
+-- rely on these primitives.
+class (MonadFail p, MonadPlus p) => MonadParser p where
+  -- | Get file name associated with current parser
+  getFile :: p FilePath
+
+  -- | Get current position of the parser
+  getPos :: p Pos
+
+  -- | Get reference position used for indentation-sensitive parsing
+  getRefPos :: p Pos
+
+  -- | Update reference position with current position
+  withRefPos :: p a -> p a
+
+  -- | Parser which succeeds when the given parser fails
+  notFollowedBy :: Show a => p a -> p ()
+
+  -- | Look ahead and return result of the given parser
+  -- The current position stays the same.
+  lookAhead :: p a -> p a
+
+  -- | Parser failure with detailled 'Error'
+  failWith :: Error -> p a
+
+  -- | Parser which succeeds at the end of file
+  eof :: p ()
+
+  -- | Annotate the given parser with a label
+  -- used for error reporting
+  label :: String -> p a -> p a
+
+  -- | Hide errors occurring within the given parser
+  -- from the error report. Based on the given
+  -- labels an 'Error' is constructed instead.
+  hidden :: p a -> p a
+
+  -- | Commit to the given branch, increasing
+  -- the priority of the errors within this branch
+  -- in contrast to other branches.
+  --
+  -- This is basically the opposite of the `try`
+  -- combinator provided by other parser combinator
+  -- libraries, which decreases the error priority
+  -- within the given branch (and usually also influences backtracking).
+  --
+  -- __Note__: `commit` only applies to the reported
+  -- errors, it has no effect on the backtracking behavior
+  -- of the parser.
+  commit :: p a -> p a
+
+  -- | Parse a single byte
+  byte :: Word8 -> p Word8
+
+  -- | Parse a single UTF-8 character
+  char :: Char -> p Char
+
+  -- | Parse a single character with the given predicate
+  satisfy :: (Char -> Bool) -> p Char
+
+  -- | Parse a single byte with the given predicate
+  byteSatisfy :: (Word8 -> Bool) -> p Word8
+
+  -- | Parse a string of bytes
+  bytes :: ByteString -> p ByteString
+
+  -- | Run the given parser and return the
+  -- result as bytes
+  asBytes :: p () -> p ByteString
+
+-- | Pretty string representation of 'Error'
+showError :: Error -> String
+showError EEmpty                   = "No error"
+showError EInvalidUtf8             = "Invalid UTF-8 character found"
+showError EExpectedEnd             = "Expected end of file"
+showError (EExpected tokens)       = "Expected " <> intercalate ", " tokens
+showError (EUnexpected token)      = "Unexpected " <> token
+showError (EFail msg)              = msg
+showError (ECombinator name)       = "Combinator " <> name <> " failed"
+showError (EIndentNotAligned rc c) = "Invalid alignment, expected column " <> show rc <> " expected, got " <> show c
+showError (EIndentOverLine   rl l) = "Indentation over line, expected line " <> show rl <> ", got " <> show l
+showError (ENotEnoughIndent  rc c) = "Not enough indentation, expected column " <> show rc <> ", got " <> show c
diff --git a/src/Text/PariPari/Combinators.hs b/src/Text/PariPari/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Combinators.hs
@@ -0,0 +1,457 @@
+module Text.PariPari.Combinators (
+  -- * Basics
+  Text
+  , void
+  , (<|>)
+  , empty
+  , optional
+
+  -- * Control.Monad.Combinators.NonEmpty
+  , NonEmpty(..)
+  , ON.some
+  , ON.endBy1
+  , ON.someTill
+  , ON.sepBy1
+  , ON.sepEndBy1
+
+  -- * Control.Monad.Combinators
+  , O.many -- dont use Applicative version for efficiency
+  , O.between
+  , O.choice
+  , O.count
+  , O.count'
+  , O.eitherP
+  , O.endBy
+  , O.manyTill
+  , O.option
+  , O.sepBy
+  , O.sepEndBy
+  , O.skipMany
+  , O.skipSome
+  , O.skipCount
+  , O.skipManyTill
+  , O.skipSomeTill
+
+  -- * PariPari
+  , (<?>)
+  , getLine
+  , getColumn
+  , withPos
+  , withSpan
+  , getRefColumn
+  , getRefLine
+  , withRefPos
+  , align
+  , indented
+  , line
+  , linefold
+  , notByte
+  , anyByte
+  , digitByte
+  , asciiByte
+  , integer
+  , integer'
+  , decimal
+  , octal
+  , hexadecimal
+  , digit
+  , signed
+  , fractionHex
+  , fractionDec
+  , char'
+  , notChar
+  , anyChar
+  , alphaNumChar
+  , digitChar
+  , letterChar
+  , lowerChar
+  , upperChar
+  , symbolChar
+  , categoryChar
+  , punctuationChar
+  , spaceChar
+  , asciiChar
+  , string
+  , string'
+  , asString
+  , takeBytes
+  , skipChars
+  , skipBytes
+  , takeChars
+  , skipCharsWhile
+  , takeCharsWhile
+  , skipBytesWhile
+  , takeBytesWhile
+  , skipBytesWhile1
+  , takeBytesWhile1
+  , skipCharsWhile1
+  , takeCharsWhile1
+) where
+
+import Control.Applicative ((<|>), empty, optional)
+import Control.Monad (when)
+import Control.Monad.Combinators (option, skipCount, skipMany)
+import Data.List.NonEmpty (NonEmpty(..))
+import Text.PariPari.Ascii
+import Text.PariPari.Class
+import Data.Text (Text)
+import Data.Functor (void)
+import Prelude hiding (getLine)
+import qualified Control.Monad.Combinators as O
+import qualified Control.Monad.Combinators.NonEmpty as ON
+import qualified Data.Char as C
+import qualified Data.Text.Encoding as T
+import qualified Data.Text as T
+
+infix 0 <?>
+
+-- | Infix alias for 'label'
+(<?>) :: MonadParser p => p a -> String -> p a
+(<?>) = flip label
+{-# INLINE (<?>) #-}
+
+-- | Get line number of the reference position
+getRefLine :: Parser Int
+getRefLine = _posLine <$> getRefPos
+{-# INLINE getRefLine #-}
+
+-- | Get column number of the reference position
+getRefColumn :: Parser Int
+getRefColumn = _posColumn <$> getRefPos
+{-# INLINE getRefColumn #-}
+
+-- | Get current line number
+getLine :: Parser Int
+getLine = _posLine <$> getPos
+{-# INLINE getLine #-}
+
+-- | Get current column
+getColumn :: Parser Int
+getColumn = _posColumn <$> getPos
+{-# INLINE getColumn #-}
+
+-- | Decorate the parser result with the current position
+withPos :: MonadParser p => p a -> p (Pos, a)
+withPos p = do
+  pos <- getPos
+  ret <- p
+  pure (pos, ret)
+{-# INLINE withPos #-}
+
+type Span = (Pos, Pos)
+
+-- | Decoreate the parser result with the position span
+withSpan :: MonadParser p => p a -> p (Span, a)
+withSpan p = do
+  begin <- getPos
+  ret <- p
+  end <- getPos
+  pure ((begin, end), ret)
+{-# INLINE withSpan #-}
+
+-- | Parser succeeds on the same line as the reference line
+line :: Parser ()
+line = do
+  l <- getLine
+  rl <- getRefLine
+  when (l /= rl) $ failWith $ EIndentOverLine rl l
+{-# INLINE line #-}
+
+-- | Parser succeeds on the same column as the reference column
+align :: Parser ()
+align = do
+  c <- getColumn
+  rc <- getRefColumn
+  when (c /= rc) $ failWith $ EIndentNotAligned rc c
+{-# INLINE align #-}
+
+-- | Parser succeeds for columns greater than the current reference column
+indented :: Parser ()
+indented = do
+  c <- getColumn
+  rc <- getRefColumn
+  when (c <= rc) $ failWith $ ENotEnoughIndent rc c
+{-# INLINE indented #-}
+
+-- | Parser succeeds either on the reference line or
+-- for columns greater than the current reference column
+linefold :: Parser ()
+linefold = line <|> indented
+{-# INLINE linefold #-}
+
+-- | Parser a single byte different from the given one
+notByte :: Word8 -> Parser Word8
+notByte b = byteSatisfy (/= b) <?> "not " <> showByte b
+{-# INLINE notByte #-}
+
+-- | Parse an arbitrary byte
+anyByte :: Parser Word8
+anyByte = byteSatisfy (const True)
+{-# INLINE anyByte #-}
+
+-- | Parse a byte of the ASCII charset (< 128)
+asciiByte :: Parser Word8
+asciiByte = byteSatisfy (< 128)
+{-# INLINE asciiByte #-}
+
+-- | Parse a digit byte for the given base.
+-- Bases 2 to 36 are supported.
+digitByte :: Int -> Parser Word8
+digitByte base = byteSatisfy (isDigit base)
+{-# INLINE digitByte #-}
+
+-- | Parse an integer of the given base.
+-- Returns the integer and the number of digits.
+-- Bases 2 to 36 are supported.
+-- Digits can be separated by separator, e.g. `optional (char '_')`.
+integer' :: (Num a, MonadParser p) => p sep -> Int -> p (a, Int)
+integer' sep base = label (integerLabel base) $ do
+  d <- digit base
+  accum 1 $ fromIntegral d
+  where accum !i !n = next i n <|> pure (n, i)
+        next !i !n = do
+          void $ sep
+          d <- digit base
+          accum (i + 1) $ n * fromIntegral base + fromIntegral d
+{-# INLINE integer' #-}
+
+-- | Parse an integer of the given base.
+-- Bases 2 to 36 are supported.
+-- Digits can be separated by separator, e.g. `optional (char '_')`.
+integer :: (Num a, MonadParser p) => p sep -> Int -> p a
+integer sep base = label (integerLabel base) $ do
+  d <- digit base
+  accum $ fromIntegral d
+  where accum !n = next n <|> pure n
+        next !n = do
+          void $ sep
+          d <- digit base
+          accum $ n * fromIntegral base + fromIntegral d
+{-# INLINE integer #-}
+
+integerLabel :: Int -> String
+integerLabel 2  = "binary integer"
+integerLabel 8  = "octal integer"
+integerLabel 10 = "decimal integer"
+integerLabel 16 = "hexadecimal integer"
+integerLabel b  = "integer of base " <> show b
+
+decimal :: Num a => Parser a
+decimal = integer (pure ()) 10
+{-# INLINE decimal #-}
+
+octal :: Num a => Parser a
+octal = integer (pure ()) 8
+{-# INLINE octal #-}
+
+hexadecimal :: Num a => Parser a
+hexadecimal = integer (pure ()) 16
+{-# INLINE hexadecimal #-}
+
+digitToInt :: Int -> Word8 -> Word
+digitToInt base b
+  | n <- (fromIntegral b :: Word) - fromIntegral asc_0, base <= 10 || n <= 9  = n
+  | n <- (fromIntegral b :: Word) - fromIntegral asc_A, n               <= 26 = n + 10
+  | n <- (fromIntegral b :: Word) - fromIntegral asc_a                        = n + 10
+{-# INLINE digitToInt #-}
+
+-- | Parse a single digit of the given base and return its value.
+-- Bases 2 to 36 are supported.
+digit :: Int -> Parser Word
+digit base = digitToInt base <$> byteSatisfy (isDigit base)
+{-# INLINE digit #-}
+
+isDigit :: Int -> Word8 -> Bool
+isDigit base b
+  | base >= 2 && base <= 10 = b >= asc_0 && b <= asc_0 + fromIntegral base - 1
+  | base <= 36 = (b >= asc_0 && b <= asc_9)
+                 || ((fromIntegral b :: Word) - fromIntegral asc_A) < fromIntegral (base - 10)
+                 || ((fromIntegral b :: Word) - fromIntegral asc_a) < fromIntegral (base - 10)
+  |otherwise = error "Text.PariPari.Combinators.isDigit: Bases 2 to 36 are supported"
+{-# INLINE isDigit #-}
+
+-- | Parse a number with a plus or minus sign.
+signed :: (Num a, MonadParser p) => p a -> p a
+signed p = ($) <$> ((id <$ byte asc_plus) <|> (negate <$ byte asc_minus) <|> pure id) <*> p
+{-# INLINE signed #-}
+
+-- | Parse a fraction of arbitrary exponent base and coefficient base.
+-- 'fractionDec' and 'fractionHex' should be used instead probably.
+fraction :: (Num a, MonadParser p) => p expSep -> Int -> Int -> p digitSep -> p (a, Int, a)
+fraction expSep expBase coeffBasePow digitSep = do
+  let coeffBase = expBase ^ coeffBasePow
+  coeff <- integer digitSep coeffBase
+  void $ optional $ byte asc_point
+  (frac, fracLen) <- option (0, 0) $ integer' digitSep coeffBase
+  expVal <- option 0 $ expSep *> signed (integer digitSep 10)
+  pure (coeff * fromIntegral coeffBase ^ fracLen + frac,
+        expBase,
+        expVal - fromIntegral (fracLen * coeffBasePow))
+{-# INLINE fraction #-}
+
+-- | Parse a decimal fraction, returning (coefficient, 10, exponent),
+-- corresponding to coefficient * 10^exponent.
+-- Digits can be separated by separator, e.g. `optional (char '_')`.
+fractionDec :: (Num a, MonadParser p) => p digitSep -> p (a, Int, a)
+fractionDec sep = fraction (byteSatisfy (\b -> b == asc_E || b == asc_e)) 10 1 sep <?> "fraction"
+{-# INLINE fractionDec #-}
+
+-- | Parse a hexadecimal fraction, returning (coefficient, 2, exponent),
+-- corresponding to coefficient * 2^exponent.
+-- Digits can be separated by separator, e.g. `optional (char '_')`.
+fractionHex :: (Num a, MonadParser p) => p digitSep -> p (a, Int, a)
+fractionHex sep = fraction (byteSatisfy (\b -> b == asc_P || b == asc_p)) 2 4 sep <?> "hexadecimal fraction"
+{-# INLINE fractionHex #-}
+
+-- | Parse a case-insensitive character
+char' :: Char -> Parser Char
+char' x =
+  let l = C.toLower x
+      u = C.toUpper x
+  in satisfy (\c -> c == l || c == u)
+{-# INLINE char' #-}
+
+-- | Parse a character different from the given one.
+notChar :: Char -> Parser Char
+notChar c = satisfy (/= c)
+{-# INLINE notChar #-}
+
+-- | Parse an arbitrary character.
+anyChar :: Parser Char
+anyChar = satisfy (const True)
+{-# INLINE anyChar #-}
+
+-- | Parse an alphanumeric character, including Unicode.
+alphaNumChar :: Parser Char
+alphaNumChar = satisfy C.isAlphaNum <?> "alphanumeric character"
+{-# INLINE alphaNumChar #-}
+
+-- | Parse a letter character, including Unicode.
+letterChar :: Parser Char
+letterChar = satisfy C.isLetter <?> "letter"
+{-# INLINE letterChar #-}
+
+-- | Parse a lowercase letter, including Unicode.
+lowerChar :: Parser Char
+lowerChar = satisfy C.isLower <?> "lowercase letter"
+{-# INLINE lowerChar #-}
+
+-- | Parse a uppercase letter, including Unicode.
+upperChar :: Parser Char
+upperChar = satisfy C.isUpper <?> "uppercase letter"
+{-# INLINE upperChar #-}
+
+-- | Parse a space character, including Unicode.
+spaceChar :: Parser Char
+spaceChar = satisfy C.isSpace <?> "space"
+{-# INLINE spaceChar #-}
+
+-- | Parse a symbol character, including Unicode.
+symbolChar :: Parser Char
+symbolChar = satisfy C.isSymbol <?> "symbol"
+{-# INLINE symbolChar #-}
+
+-- | Parse a punctuation character, including Unicode.
+punctuationChar :: Parser Char
+punctuationChar = satisfy C.isPunctuation <?> "punctuation"
+{-# INLINE punctuationChar #-}
+
+-- | Parse a digit character of the given base.
+-- Bases 2 to 36 are supported.
+digitChar :: Int -> Parser Char
+digitChar base = unsafeAsciiToChar <$> digitByte base
+{-# INLINE digitChar #-}
+
+-- | Parse a character beloning to the ASCII charset (< 128)
+asciiChar :: Int -> Parser Char
+asciiChar base = unsafeAsciiToChar <$> digitByte base
+{-# INLINE asciiChar #-}
+
+-- | Parse a character belonging to the given Unicode category
+categoryChar :: C.GeneralCategory -> Parser Char
+categoryChar cat = satisfy ((== cat) . C.generalCategory) <?> untitle (show cat)
+{-# INLINE categoryChar #-}
+
+-- | Parse a text string
+string :: Text -> Parser Text
+string t = t <$ bytes (T.encodeUtf8 t)
+{-# INLINE string #-}
+
+string' :: Text -> Parser Text
+string' s = asString (go s) <?> "case-insensitive \"" <> T.unpack (T.toLower s) <> "\""
+  where go t
+          | T.null t  = pure ()
+          | otherwise = char' (T.head t) *> go (T.tail t)
+{-# INLINE string' #-}
+
+-- | Run the given parser but return the result as a 'Text' string
+asString :: MonadParser p => p () -> p Text
+asString p = T.decodeUtf8 <$> asBytes p
+{-# INLINE asString #-}
+
+-- | Take the next n bytes and advance the position by n bytes
+takeBytes :: Int -> Parser ByteString
+takeBytes n = asBytes (skipBytes n) <?> show n <> " bytes"
+{-# INLINE takeBytes #-}
+
+-- | Skip the next n bytes
+skipBytes :: Int -> Parser ()
+skipBytes n = skipCount n anyByte
+{-# INLINE skipBytes #-}
+
+-- | Skip the next n characters
+skipChars :: Int -> Parser ()
+skipChars n = skipCount n anyChar
+{-# INLINE skipChars #-}
+
+-- | Take the next n characters and advance the position by n characters
+takeChars :: Int -> Parser Text
+takeChars n = asString (skipChars n) <?> "string of length " <> show n
+{-# INLINE takeChars #-}
+
+-- | Skip char while predicate is true
+skipCharsWhile :: (Char -> Bool) -> Parser ()
+skipCharsWhile f = skipMany (satisfy f)
+{-# INLINE skipCharsWhile #-}
+
+-- | Take chars while predicate is true
+takeCharsWhile :: (Char -> Bool) -> Parser Text
+takeCharsWhile f = asString (skipCharsWhile f)
+{-# INLINE takeCharsWhile #-}
+
+-- | Skip bytes while predicate is true
+skipBytesWhile :: (Word8 -> Bool) -> Parser ()
+skipBytesWhile f = skipMany (byteSatisfy f)
+{-# INLINE skipBytesWhile #-}
+
+-- | Takes bytes while predicate is true
+takeBytesWhile :: (Word8 -> Bool) -> Parser ByteString
+takeBytesWhile f = asBytes (skipBytesWhile f)
+{-# INLINE takeBytesWhile #-}
+
+-- | Skip at least one byte while predicate is true
+skipBytesWhile1 :: (Word8 -> Bool) -> Parser ()
+skipBytesWhile1 f = byteSatisfy f *> skipBytesWhile f
+{-# INLINE skipBytesWhile1 #-}
+
+-- | Take at least one byte while predicate is true
+takeBytesWhile1 :: (Word8 -> Bool) -> Parser ByteString
+takeBytesWhile1 f = asBytes (skipBytesWhile1 f)
+{-# INLINE takeBytesWhile1 #-}
+
+-- | Skip at least one byte while predicate is true
+skipCharsWhile1 :: (Char -> Bool) -> Parser ()
+skipCharsWhile1 f = satisfy f *> skipCharsWhile f
+{-# INLINE skipCharsWhile1 #-}
+
+-- | Take at least one byte while predicate is true
+takeCharsWhile1 :: (Char -> Bool) -> Parser Text
+takeCharsWhile1 f = asString (skipCharsWhile1 f)
+{-# INLINE takeCharsWhile1 #-}
+
+untitle :: String -> String
+untitle []     = []
+untitle (x:xs) = C.toLower x : go xs
+  where go [] = ""
+        go (y:ys) | C.isUpper y = ' ' : C.toLower y : untitle ys
+                  | otherwise   = y : ys
diff --git a/src/Text/PariPari/Decode.hs b/src/Text/PariPari/Decode.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Decode.hs
@@ -0,0 +1,90 @@
+module Text.PariPari.Decode (
+  bytesEqual
+  , byteAt
+  , utf8Decode
+  , utf8DecodeFixed
+  , utf8Width
+) where
+
+import Data.Word (Word8)
+import Data.Bits (unsafeShiftL, (.|.), (.&.))
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import Foreign.Ptr (plusPtr)
+import Foreign.Storable (peekByteOff)
+import GHC.Base (unsafeChr)
+import qualified Data.ByteString.Internal as B
+
+bytesEqual :: ForeignPtr Word8 -> Int -> ForeignPtr Word8 -> Int -> Int -> Bool
+bytesEqual p1 i1 p2 i2 n =
+  B.accursedUnutterablePerformIO $
+  withForeignPtr p1 $ \q1 ->
+  withForeignPtr p2 $ \q2 ->
+  (== 0) <$> B.memcmp (q1 `plusPtr` i1) (q2 `plusPtr` i2) n
+{-# INLINE bytesEqual #-}
+
+byteAt :: ForeignPtr Word8 -> Int -> Word8
+byteAt p i = B.accursedUnutterablePerformIO $
+  withForeignPtr p $ \q -> peekByteOff q i
+{-# INLINE byteAt #-}
+
+at :: ForeignPtr Word8 -> Int -> Int
+at p i = fromIntegral $ byteAt p i
+{-# INLINE at #-}
+
+-- | Decode UTF-8 character at the given offset relative to the pointer
+utf8Decode :: ForeignPtr Word8 -> Int -> (Char, Int)
+utf8Decode p i
+  | a1 <- at p i,
+    a1 <= 0x7F =
+    (unsafeChr a1, 1)
+  | a1 <- at p i, a2 <- at p (i + 1),
+    (a1 .&. 0xE0) == 0xC0,
+    (a2 .&. 0xC0) == 0x80 =
+    (unsafeChr (((a1 .&. 31) `unsafeShiftL` 6)
+                .|. (a2 .&. 0x3F)), 2)
+  | a1 <- at p i, a2 <- at p (i + 1), a3 <- at p (i + 2),
+    (a1 .&. 0xF0) == 0xE0,
+    (a2 .&. 0xC0) == 0x80,
+    (a3 .&. 0xC0) == 0x80 =
+    (unsafeChr (((a1 .&. 15) `unsafeShiftL` 12)
+                 .|. ((a2 .&. 0x3F) `unsafeShiftL` 6)
+                 .|. (a3 .&. 0x3F)), 3)
+  | a1 <- at p i, a2 <- at p (i + 1), a3 <- at p (i + 2), a4 <- at p (i + 3),
+    (a1 .&. 0xF8) == 0xF0,
+    (a2 .&. 0xC0) == 0x80,
+    (a3 .&. 0xC0) == 0x80,
+    (a4 .&. 0xC0) == 0x80 =
+    (unsafeChr (((a1 .&. 7) `unsafeShiftL` 18)
+                 .|. ((a2 .&. 0x3F) `unsafeShiftL` 12)
+                 .|. ((a3 .&. 0x3F) `unsafeShiftL` 6)
+                 .|. (a4 .&. 0x3F)), 4)
+  | otherwise = ('\0', 0)
+{-# INLINE utf8Decode #-}
+
+-- | Decode UTF-8 character with known width at the given offset relative to the pointer
+utf8DecodeFixed :: Int -> ForeignPtr Word8 -> Int -> Char
+utf8DecodeFixed w p i = unsafeChr $
+  case w of
+    1 -> at p i
+    2 | a1 <- at p i, a2 <- at p (i + 1) ->
+        ((a1 .&. 31) `unsafeShiftL` 6)
+        .|. (a2 .&. 0x3F)
+    3 | a1 <- at p i, a2 <- at p (i + 1), a3 <- at p (i + 2) ->
+        ((a1 .&. 15) `unsafeShiftL` 12)
+        .|. ((a2 .&. 0x3F) `unsafeShiftL` 6)
+        .|. (a3 .&. 0x3F)
+    4 | a1 <- at p i, a2 <- at p (i + 1), a3 <- at p (i + 2), a4 <- at p (i + 3) ->
+        ((a1 .&. 7) `unsafeShiftL` 18)
+        .|. ((a2 .&. 0x3F) `unsafeShiftL` 12)
+        .|. ((a3 .&. 0x3F) `unsafeShiftL` 6)
+        .|. (a4 .&. 0x3F)
+    _ -> 0
+{-# INLINE utf8DecodeFixed #-}
+
+-- | Bytes width of an UTF-8 character
+utf8Width :: Char -> Int
+utf8Width c | c <= unsafeChr 0x7F = 1
+            | c <= unsafeChr 0x7FF = 2
+            | c <= unsafeChr 0xFFFF = 3
+            | otherwise = 4
+{-# INLINE utf8Width #-}
diff --git a/src/Text/PariPari/Reporter.hs b/src/Text/PariPari/Reporter.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PariPari/Reporter.hs
@@ -0,0 +1,421 @@
+module Text.PariPari.Reporter (
+  Reporter
+  , Report(..)
+  , runReporter
+  , runReporterWithOptions
+  , ErrorContext
+  , showReport
+  , showErrors
+  , ReportOptions(..)
+  , defaultReportOptions
+  , Tracer
+  , runTracer
+) where
+
+import Control.Monad (void)
+import Data.Function (on)
+import Data.List (intercalate, sort, group, sortOn)
+import Data.List.NonEmpty (NonEmpty(..))
+import Debug.Trace (trace)
+import Foreign.ForeignPtr (ForeignPtr)
+import GHC.Generics (Generic)
+import Text.PariPari.Ascii
+import Text.PariPari.Class
+import Text.PariPari.Decode
+import qualified Control.Monad.Fail as Fail
+import qualified Data.ByteString.Internal as B
+import qualified Data.List.NonEmpty as NE
+
+type ErrorContext = ([Error], [String])
+
+data ReportOptions = ReportOptions
+  { _optMaxContexts         :: !Int
+  , _optMaxErrorsPerContext :: !Int
+  , _optMaxLabelsPerContext :: !Int
+  } deriving (Eq, Show, Generic)
+
+data Report = Report
+  { _reportFile   :: !FilePath
+  , _reportLine   :: !Int
+  , _reportCol    :: !Int
+  , _reportErrors :: [ErrorContext]
+  } deriving (Eq, Show, Generic)
+
+data Env = Env
+  { _envSrc     :: !(ForeignPtr Word8)
+  , _envEnd     :: !Int
+  , _envFile    :: !FilePath
+  , _envOptions :: !ReportOptions
+  , _envHidden  :: !Bool
+  , _envCommit  :: !Int
+  , _envContext :: [String]
+  , _envRefLine :: !Int
+  , _envRefCol  :: !Int
+  }
+
+data State = State
+  { _stOff       :: !Int
+  , _stLine      :: !Int
+  , _stCol       :: !Int
+  , _stErrOff    :: !Int
+  , _stErrLine   :: !Int
+  , _stErrCol    :: !Int
+  , _stErrCommit :: !Int
+  , _stErrors    :: [ErrorContext]
+  }
+
+-- | Parser which is optimized for good error reports.
+-- Performance is secondary, since the 'Reporter' is used
+-- as a fallback to the 'Acceptor'.
+newtype Reporter a = Reporter
+  { unReporter :: forall b. Env -> State
+               -> (a     -> State -> b)
+               -> (State -> b)
+               -> b
+  }
+
+instance Semigroup a => Semigroup (Reporter a) where
+  p1 <> p2 = (<>) <$> p1 <*> p2
+  {-# INLINE (<>) #-}
+
+instance Monoid a => Monoid (Reporter a) where
+  mempty = pure mempty
+  {-# INLINE mempty #-}
+
+instance Functor Reporter where
+  fmap f p = Reporter $ \env st ok err ->
+    unReporter p env st (ok . f) err
+  {-# INLINE fmap #-}
+
+instance Applicative Reporter where
+  pure x = Reporter $ \_ st ok _ -> ok x st
+  {-# INLINE pure #-}
+
+  f <*> a = Reporter $ \env st ok err ->
+    let ok1 f' s =
+          let ok2 a' s' = ok (f' a') s'
+          in unReporter a env s ok2 err
+    in unReporter f env st ok1 err
+  {-# INLINE (<*>) #-}
+
+  p1 *> p2 = do
+    void p1
+    p2
+  {-# INLINE (*>) #-}
+
+  p1 <* p2 = do
+    x <- p1
+    void p2
+    pure x
+  {-# INLINE (<*) #-}
+
+instance Alternative Reporter where
+  empty = Reporter $ \_ st _ err -> err st
+  {-# INLINE empty #-}
+
+  p1 <|> p2 = Reporter $ \env st ok err ->
+    let err' s = unReporter p2 env (mergeStateErrors env st s) ok err
+    in unReporter p1 env st ok err'
+  {-# INLINE (<|>) #-}
+
+instance MonadPlus Reporter
+
+instance Monad Reporter where
+  p >>= f = Reporter $ \env st ok err ->
+    let ok' x s = unReporter (f x) env s ok err
+    in unReporter p env st ok' err
+  {-# INLINE (>>=) #-}
+
+  fail msg = Fail.fail msg
+  {-# INLINE fail #-}
+
+instance Fail.MonadFail Reporter where
+  fail msg = failWith $ EFail msg
+  {-# INLINE fail #-}
+
+instance MonadParser Reporter where
+  getPos = get $ \_ st -> Pos (_stLine st) (_stCol st)
+  {-# INLINE getPos #-}
+
+  getFile = get $ \env _ -> _envFile env
+  {-# INLINE getFile #-}
+
+  getRefPos = get $ \env _ -> Pos (_envRefLine env) (_envRefCol env)
+  {-# INLINE getRefPos #-}
+
+  withRefPos p = local (\st env -> env { _envRefLine = _stLine st, _envRefCol = _stCol st }) p
+  {-# INLINE withRefPos #-}
+
+  label l p = local (const $ addLabel l) p
+  {-# INLINE label #-}
+
+  hidden p = local (const $ \env -> env { _envHidden = True }) p
+  {-# INLINE hidden #-}
+
+  commit p = local (const $ \env -> env { _envCommit = _envCommit env + 1 }) p
+  {-# INLINE commit #-}
+
+  notFollowedBy p = Reporter $ \env st ok err ->
+    let ok' x _ = raiseError env st err $ EUnexpected $ show x
+        err' _ = ok () st
+    in unReporter p env st ok' err'
+  {-# INLINE notFollowedBy #-}
+
+  lookAhead p = Reporter $ \env st ok err ->
+    let ok' x _ = ok x st
+    in unReporter p env st ok' err
+  {-# INLINE lookAhead #-}
+
+  failWith e = Reporter $ \env st _ err -> raiseError env st err e
+  {-# INLINE failWith #-}
+
+  eof = Reporter $ \env st ok err ->
+    if _stOff st >= _envEnd env then
+      ok () st
+    else
+      raiseError env st err EExpectedEnd
+  {-# INLINE eof #-}
+
+  byte b = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    if | _stOff >= _envEnd env -> err st
+       | b == byteAt (_envSrc env) _stOff ->
+           ok b st
+           { _stOff =_stOff + 1
+           , _stLine = if b == asc_newline then _stLine + 1 else _stLine
+           , _stCol = if b == asc_newline then 1 else _stCol + 1
+           }
+       | otherwise ->
+           raiseError env st err $ EExpected [showByte b]
+  {-# INLINE byte #-}
+
+  byteSatisfy f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    let b = byteAt (_envSrc env) _stOff
+    in if | _stOff >= _envEnd env -> err st
+          | f b ->
+              ok b st
+              { _stOff =_stOff + 1
+              , _stLine = if b == asc_newline then _stLine + 1 else _stLine
+              , _stCol = if b == asc_newline then 1 else _stCol + 1
+              }
+          | otherwise ->
+              raiseError env st err $ EUnexpected $ showByte b
+  {-# INLINE byteSatisfy #-}
+
+  bytes b@(B.PS p i n) = Reporter $ \env st@State{_stOff,_stCol} ok err ->
+    if n + _stOff <= _envEnd env &&
+       bytesEqual (_envSrc env) _stOff p i n then
+      ok b st { _stOff = _stOff + n, _stCol = _stCol + n }
+    else
+      raiseError env st err $ EExpected [showBytes b]
+  {-# INLINE bytes #-}
+
+  asBytes p = do
+    begin <- get (const _stOff)
+    p
+    end <- get (const _stOff)
+    src <- get (\env _ -> _envSrc env)
+    pure $ B.PS src begin (end - begin)
+  {-# INLINE asBytes #-}
+
+  satisfy f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+    let (c, w) = utf8Decode (_envSrc env) _stOff
+    in if | c /= '\0' ->
+            if f c then
+              ok c st
+              { _stOff =_stOff + w
+              , _stLine = if c == '\n' then _stLine + 1 else _stLine
+              , _stCol = if c == '\n' then 1 else _stCol + 1
+              }
+            else
+              raiseError env st err $ EUnexpected $ show c
+          | c == '\0' && _stOff >= _envEnd env -> err st
+          | otherwise -> raiseError env st err EInvalidUtf8
+  {-# INLINE satisfy #-}
+
+  char c =
+    let w = utf8Width c
+    in Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->
+      if utf8DecodeFixed w (_envSrc env) _stOff == c then
+        ok c st
+        { _stOff =_stOff + w
+        , _stLine = if c == '\n' then _stLine + 1 else _stLine
+        , _stCol = if c == '\n' then 1 else _stCol + 1
+        }
+      else
+        raiseError env st err $ EExpected [show c]
+  {-# INLINE char #-}
+
+raiseError :: Env -> State -> (State -> b) -> Error -> b
+raiseError env st err e = err $ addError env st e
+{-# INLINE raiseError #-}
+
+-- | Reader monad, modify environment locally
+local :: (State -> Env -> Env) -> Reporter a -> Reporter a
+local f p = Reporter $ \env st ok err ->
+  unReporter p (f st env) st ok err
+{-# INLINE local #-}
+
+-- | Reader monad, get something from the environment
+get :: (Env -> State -> a) -> Reporter a
+get f = Reporter $ \env st ok _ -> ok (f env st) st
+{-# INLINE get #-}
+
+addLabel :: String -> Env -> Env
+addLabel l env = case _envContext env of
+  (l':_) | l == l' -> env
+  ls               -> env { _envContext = take (_optMaxLabelsPerContext._envOptions $ env) $ l : ls }
+{-# INLINE addLabel #-}
+
+-- | Add parser error to the list of errors
+-- which are kept in the parser state.
+-- Errors of lower priority and at an earlier position.
+-- Furthermore the error is merged with existing errors if possible.
+addError :: Env -> State -> Error -> State
+addError env st e
+  | _stOff st > _stErrOff st || _envCommit env > _stErrCommit st,
+    Just e' <- mkError env e =
+      st { _stErrors    = [e']
+         , _stErrOff    = _stOff st
+         , _stErrLine   = _stLine st
+         , _stErrCol    = _stCol st
+         , _stErrCommit = _envCommit env
+         }
+  | _stOff st == _stErrOff st && _envCommit env == _stErrCommit st,
+    Just e' <- mkError env e =
+      st { _stErrors = shrinkErrors env $ e' : _stErrors st }
+  | otherwise = st
+{-# INLINE addError #-}
+
+mkError :: Env -> Error -> Maybe ErrorContext
+mkError env e
+  | _envHidden env, (l:ls) <- _envContext env = Just $ ([EExpected [l]], ls)
+  | _envHidden env = Nothing
+  | otherwise = Just $ ([e], _envContext env)
+{-# INLINE mkError #-}
+
+-- | Merge errors of two states, used when backtracking
+mergeStateErrors :: Env -> State -> State -> State
+mergeStateErrors env s s'
+  | _stErrOff s' > _stErrOff s || _stErrCommit s' > _stErrCommit s =
+      s { _stErrors    = _stErrors s'
+        , _stErrOff    = _stErrOff s'
+        , _stErrLine   = _stErrLine s'
+        , _stErrCol    = _stErrCol s'
+        , _stErrCommit = _stErrCommit s'
+        }
+  | _stErrOff s' == _stErrOff s && _stErrCommit s' == _stErrCommit s =
+      s { _stErrors = shrinkErrors env $ _stErrors s' <> _stErrors s }
+  | otherwise = s
+{-# INLINE mergeStateErrors #-}
+
+groupOn :: Eq e => (a -> e) -> [a] -> [NonEmpty a]
+groupOn f = NE.groupBy ((==) `on` f)
+
+shrinkErrors :: Env -> [ErrorContext] -> [ErrorContext]
+shrinkErrors env = take (_optMaxContexts._envOptions $ env) . map (mergeErrorContexts env) . groupOn snd . sortOn snd
+
+-- | Shrink error context by deleting duplicates
+-- and merging errors if possible.
+mergeErrorContexts :: Env -> NonEmpty ErrorContext -> ErrorContext
+mergeErrorContexts env es@((_, ctx):| _) = (take (_optMaxErrorsPerContext._envOptions $ env) $ nubSort $ mergeEExpected $ concatMap fst $ NE.toList es, ctx)
+
+mergeEExpected :: [Error] -> [Error]
+mergeEExpected es = [EExpected $ nubSort expects | not (null expects)] <> filter (null . asEExpected) es
+  where expects = concatMap asEExpected es
+
+nubSort :: Ord a => [a] -> [a]
+nubSort = map head . group . sort
+
+asEExpected :: Error -> [String]
+asEExpected (EExpected s) = s
+asEExpected _ = []
+
+-- | Run 'Reporter' with additional 'ReportOptions'.
+runReporterWithOptions :: ReportOptions -> Reporter a -> FilePath -> ByteString -> Either Report a
+runReporterWithOptions o p f t =
+  let b = t <> "\0\0\0"
+  in unReporter p (initialEnv o f b) (initialState b) (\x _ -> Right x) (Left . getReport f)
+
+-- | Run 'Reporter' on the given 'ByteString', returning either
+-- an error 'Report' or, if successful, the result.
+runReporter :: Reporter a -> FilePath -> ByteString -> Either Report a
+runReporter = runReporterWithOptions defaultReportOptions
+
+getReport :: FilePath -> State -> Report
+getReport f s = Report f (_stErrLine s) (_stErrCol s) (_stErrors s)
+
+initialEnv :: ReportOptions -> FilePath -> ByteString -> Env
+initialEnv _envOptions _envFile (B.PS _envSrc off len) = Env
+  { _envFile
+  , _envSrc
+  , _envOptions
+  , _envEnd     = off + len - 3
+  , _envContext = []
+  , _envHidden  = False
+  , _envCommit  = 0
+  , _envRefLine = 0
+  , _envRefCol  = 0
+  }
+
+defaultReportOptions :: ReportOptions
+defaultReportOptions = ReportOptions
+  { _optMaxContexts         = 20
+  , _optMaxErrorsPerContext = 20
+  , _optMaxLabelsPerContext = 5
+  }
+
+initialState :: ByteString -> State
+initialState (B.PS _ _stOff _) = State
+  { _stOff
+  , _stLine      = 1
+  , _stCol       = 1
+  , _stErrOff    = 0
+  , _stErrLine   = 0
+  , _stErrCol    = 0
+  , _stErrCommit = 0
+  , _stErrors    = []
+  }
+
+-- | Pretty string representation of 'Report'.
+showReport :: Report -> String
+showReport r =
+  "Parser errors at " <> _reportFile r
+  <> ", line " <> show (_reportLine r)
+  <> ", column " <> show (_reportCol r)
+  <> "\n\n" <> showErrors (_reportErrors r)
+
+-- | Pretty string representation of '[ErrorContext]'.
+showErrors :: [ErrorContext] -> String
+showErrors [] = "No errors"
+showErrors es = intercalate "\n" $ map showErrorContext es
+
+showErrorContext :: ErrorContext -> String
+showErrorContext (e, c) = intercalate ", " (map showError e) <> showContext c <> "."
+
+showContext :: [String] -> String
+showContext [] = ""
+showContext xs = " in context of " <> intercalate ", " xs
+
+-- | Parser which prints trace messages, when backtracking occurs.
+newtype Tracer a = Tracer { unTracer :: Reporter a }
+  deriving (Semigroup, Monoid, Functor, Applicative, MonadPlus, Monad, Fail.MonadFail, MonadParser)
+
+instance Alternative Tracer where
+  empty = Tracer empty
+
+  p1 <|> p2 = Tracer $ Reporter $ \env st ok err ->
+    let err' s =
+          let width = _stOff s -_stOff st
+              next  = unReporter (unTracer p2) env (mergeStateErrors env st s) ok err
+          in if width > 1 then
+               trace ("Back tracking " <> show width <> " bytes at line " <> show (_stLine s)
+                       <> ", column " <> show (_stCol s) <> ", context " <> show (_envContext env) <> ": "
+                       <> showBytes (B.PS (_envSrc env) (_stOff st) width)) next
+             else
+               next
+    in unReporter (unTracer p1) env st ok err'
+
+-- | Run 'Tracer' on the given 'ByteString', returning either
+-- an error 'Report' or, if successful, the result.
+runTracer :: Tracer a -> FilePath -> ByteString -> Either Report a
+runTracer = runReporter . unTracer