module Debug.TraceCall.IO where
import Control.Monad.Trans
import Debug.TraceCall.Base
class TCIO a where
tcIO :: TraceData -> Int -> a -> a
instance (Show a, MonadIO m) => TCIO (m a) where
tcIO td _ v = do val <- v
liftIO $ putStrLn $ traceResult td (show val)
return val
instance (TAIO a, TCIO r) => TCIO (a -> r) where
tcIO (TraceData fun as ctx) i f a = tcIO (TraceData fun (as ++ [taIO ("<<function-" ++ show i ++ ">>") a]) ctx) i (f a)
class TAIO a where
taIO :: String -> a -> String
instance (Show a) => TAIO a where
taIO _ = show
instance (TCIO (a -> r)) => TAIO (a -> r) where
taIO s = const s
traceCall :: (TCIO a) => String -> a -> a
traceCall s f = tcIO (TraceData s [] Nothing) 0 f