traceM and traceShowM
Twan van Laarhoven
twanvl at gmail.com
Wed Oct 21 14:00:58 EDT 2009
Martijn van Steenbergen wrote:
> So the current idea is:
>
>> withTrace :: Show a => a -> a
>> withTrace x = trace (show x) x
>>
>> traceM :: Monad m => String -> m ()
>> traceM msg = trace msg (return ())
>>
>> traceShowM :: (Show a, Monad m) => a -> m ()
>> traceShowM = traceM . show
>
>
> I'm not too good at writing documentation, so if someone would like to
> do that, please go ahead.
-- | When called, 'withTrace' prints its argument before returning it.
withTrace :: Show a => a -> a
-- | When called, 'traceM' outputs the string in its first argument, before
returning @()@. This function is intended for tracing in a do-block.
--
-- Note: In non-strict monads you need to write
--
-- > do () <- traceM msg
--
-- to ensure that the trace message is output.
traceM :: Monad m => String -> m ()
-- | Like 'traceM', but uses 'show' on the argument to convert it to a 'String'.
--
-- > traceShowM = traceM . show
traceShowM :: (Show a, Monad m) => a -> m ()
-------------------------------
While we are at it, there should also be some module documentation. Right now it
just says "The 'trace' function."
--
-- The 'trace' function is intended for printing debug messages.
-- Using 'trace', a message is printed as a side effect of evaluating an expression.
--
-- Example:
--
-- > fib 0 = trace "base 0" 1
-- > fib 1 = trace "base 1" 1
-- > fib n = trace ("fib "++show n) $ fib (n-1) + fib (n-2)
--
-- Depending on the evaluation order, calculating @fib 3@ might output
--
-- > fib 3
-- > fib 2
-- > base 1
-- > base 0
-- > out 2
-- > base 1
-- > out 3
--
I don't know whether adding an example is a good idea, or if it would just
distract users.
-------------------------------
While writing the above example, another thing just occured to me: it should be
possible for trace and withTrace to bracket the computation. What I mean by that
is something like
bracketTrace a1 a2 b = trace a1 (b `seq` trace a2 b)
Or separately:
-- | When called, 'traceOut' first evaluates its second argument,
-- then prints a message, and finally returns the second argument.
traceOut :: String -> a -> a
traceOut a b = b `seq` trace a b
Perhaps we can use some global state to keep track of nested trace calls, so the
above example would output
fib 3
fib 2
base 1
base 0
base 1
Twan
More information about the Libraries
mailing list