module Language.HERMIT.Primitive.Debug
(
externals
, bracketR
, observeR
, observeFailureR
, traceR
)
where
import Control.Arrow
import Language.HERMIT.Kure
import Language.HERMIT.External
import Language.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 Core => String -> RewriteH a -> RewriteH a
observeFailureR str m = m <+ observeR str
observeR :: Injection a Core => 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 Core => 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)"