module HERMIT.Dictionary.Debug
(
externals
, bracketR
, observeR
, observeFailureR
, traceR
)
where
import Control.Arrow
import HERMIT.Kure
import HERMIT.External
import HERMIT.Monad
externals :: [External]
externals = map (.+ Debug)
[ external "trace" (traceR :: String -> RewriteH Core)
[ "give a side-effect message as output when processing this command" ]
, external "observe" (observeR :: String -> RewriteH Core)
[ "give a side-effect message as output, and observe the value being processed" ]
, external "observe-failure" (observeFailureR :: String -> RewriteH Core -> RewriteH Core)
[ "give a side-effect message if the rewrite fails, including the failing input" ]
, external "bracket" (bracketR :: String -> RewriteH Core -> RewriteH Core)
[ "if given rewrite succeeds, see its input and output" ]
]
observeFailureR :: Injection a CoreTC => String -> RewriteH a -> RewriteH a
observeFailureR str m = m <+ observeR str
observeR :: Injection a CoreTC => String -> RewriteH a
observeR msg = extractR $ sideEffectR $ \ cxt core ->
sendDebugMessage $ DebugCore msg cxt core
traceR :: String -> RewriteH a
traceR msg = sideEffectR $ \ _ _ -> sendDebugMessage $ DebugTick msg
bracketR :: Injection a CoreTC => String -> RewriteH a -> RewriteH a
bracketR msg rr = do
(e,r) <- idR &&& attemptM rr
either fail (\ e' -> do _ <- return e >>> observeR before
return e' >>> observeR after) r
where before = msg ++ " (before)"
after = msg ++ " (after)"