Monad.lhs

> {-# OPTIONS_GHC -fglasgow-exts #-}
> module Curry.Debugger.Tools.Tracer.Monad where

> import Control.Monad.State
> import Control.Monad.Trans

> import Curry.Debugger.DebugMonad
> import Curry.Debugger.Oracle
> import Curry.Debugger.DebugInfo
> import Curry.Debugger.DebugInfoGoodies
> import Curry.Debugger.ShowTerm

> type TM a = DMT () IO a

> instance DM (DMT () IO) where
>     funcDeclHook name info ma = do
>         result <- ma
>         istr <- liftIO $ isTrace name info
>         when (istr)
>              (liftIO $ do
>                           let label = getName info
>                           putStrLn $ label ++ ":"
>                           putStrLn $ replicate (1 + length label) '='
>                           putStrLn $ showGenTerm result
>                           putStrLn "")
>         return result 

> traceFuncName :: (String, String)
> traceFuncName = ("Trace", "trace")

> isTrace :: String -> DI -> IO Bool
> isTrace fname di = do
>     return $ (getModuleName di, fname) == traceFuncName

> getName :: DI -> String
> getName = showTerm . head . getFuncArgs

> run :: GenTerm a => TM a -> String -> IO a
> run ta sfile = debugDMT ta sfile ()