newtype Trace a = Trace ([String], a)

instance Monad Trace where
    (Trace (traces, x)) >>= f = (Trace (traces ++ t, y))
      where
        (Trace (t, y)) = f x
    return x = Trace ([], x )

put :: Show a => String -> a -> Trace ()
put msg v = Trace ([msg ++ " " ++ show v], ())

fact :: Integer -> Trace Integer
fact n = do
   put "fact" n >> if n == 0
       then return 1
       else do
           m <- fact (n - 1)
           return (n * m)

main = let Trace (lst, m) = fact 3
       in do
           print lst
           print m