{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module Text.PariPari.Internal.Tracer (
Tracer(..)
, runTracer
) where
import Debug.Trace (trace)
import Text.PariPari.Internal.Class
import Text.PariPari.Internal.Chunk
import Text.PariPari.Internal.Reporter
import qualified Control.Monad.Fail as Fail
newtype Tracer k a = Tracer { unTracer :: Reporter k a }
deriving (Semigroup, Monoid, Functor, Applicative, MonadPlus, Monad, Fail.MonadFail)
deriving instance CharChunk k => ChunkParser k (Tracer k)
deriving instance CharChunk k => CharParser k (Tracer k)
instance Chunk k => Alternative (Tracer k) 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 (mergeErrorState env st s) ok err
in if width > 1 then
trace ("Backtracking " <> show width <> " bytes at line " <> show (_stLine s)
<> ", column " <> show (_stCol s) <> ", context " <> show (_envContext env) <> ": "
<> showChunk (packChunk @k (_envBuf env) (_stOff st) width)) next
else
next
in unReporter (unTracer p1) env st ok err'
runTracer :: Chunk k => Tracer k a -> FilePath -> k -> Either Report a
runTracer = runReporter . unTracer