[Haskell-cafe] Writer + log each computation to stdout

[Alex Vieth]

I have very little experience with monad transformers, so I took this
opportunity to learn by implementing one that will (hopefully!) solve
your problem. Here goes:

import Data.Monoid
import Control.Monad
import Control.Monad.Trans

-- Needed for an example stdout logger.
import System.IO.Unsafe

-- | LoggerT monad transformer.
-- runLoggerT demands a logging function of type a -> b (where b is a monoid).
-- It returns a monad-wrapped tuple, where the first entry is the logs and the
-- second is some value.
-- So, a is the log input type, b the log output type (probably [a]), m a monad,
-- and c some arbitrary type.
newtype LoggerT a b m c = LogT {
    runLoggerT :: (a -> b) -> m (b, c)
  }

instance (Monoid b, Monad m) => Monad (LoggerT a b m) where
  -- return is straightforward: ignore the log function and give mempty as the
  -- partial log.
  return x = LogT $ \_ -> return (mempty, x)
  -- Follow the steps for bind...
  (>>=) x k = LogT $ \l ->
    -- First we run the logger against the supplied logging function to get a
    -- base monad value
    let y = runLoggerT x l
    -- Now we exploit the base monad's bind twice:
    in y >>= (\(log0, v) ->
      -- First to feed a value to k and run the produced logger...
      let z = log0 `seq` runLoggerT (k v) l
      -- And again to concatenate the logs.
      in z >>= (\(log1, w) ->
        -- Note the use of seq here and above; without this, the stdout logger
        -- that we define later will not work.
        return $ log1 `seq` (log0 `mappend` log1, w)))

instance Monoid b => MonadTrans (LoggerT a b) where
  lift x = LogT $ \l ->
    x >>= (\v -> return (mempty, v))

-- | This function will put a message in the log.
putLog :: (Monoid b, Monad m) => a -> LoggerT a b m ()
putLog msg = LogT $ \l ->
  let msg' = l msg
  in return (msg', ())

-- | Give this to (runLoggerT m) and you'll get a list log.
runListLog action = runLoggerT action (\x -> [x])

-- | Give this to (runLoggerT m) and you'll get logs printed
-- to stdout.
runStdoutLog action = runLoggerT action spitString
  where spitString = unsafePerformIO . print

stupidExample :: Monoid b => LoggerT String b IO ()
stupidExample = do
  l <- lift getLine
  putLog $ "Got line: " ++ l
  m <- lift getLine
  putLog $ "Got another: " ++ m


Try loading it up and evaluating runStdoutLog stupidExample and
runListLog stupidExample.
If you don't like the use of unsafePerformIO, you could import
Debug.Trace instead and use

runTraceLog action = runLoggerT action (\x -> trace x ())

Alex

On 11/25/13, Tillmann Rendel <rendel at informatik.uni-marburg.de> wrote:
> Hi,
>
> Bryan Vicknair wrote:
>> I have a bunch of little database IO functions.  Each does something to
>> the
>> database, and returns a log string describing what it did, and possibly a
>> meaningful result from the database.
>>
>>    query  :: IO (String, a)
>>    update :: a -> IO (String, ())
>>
>> ...and a few functions that orchestrate all the little functions into
>> doing
>> useful work.
>>
>>    syncWeek :: Week -> IO ()
>>    syncAll  : : IO ()
>>
>> I don't want the individual functions to know what is done with the log
>> string
>> describing what they did.  Top-level orchestrating functions should make
>> that
>> decision, which can be one of:
>>
>> 1) Collect and print all to a log once all computations are done.
>> 2) Print to stdout *as each computation is run*.
>> 3) Ignore them.
>
> Instead of using an existing monad transformer, I would consider to
> write my own set of logging monad transformers. This could give you this
> interface:
>
>    class MonadLog m where
>      log :: String -> m ()
>
>    query :: (MonadIO m, MonadLog m) => m a
>    update :: (MonadIO m, MonadLog m) => a -> m ()
>
> And then you can provide different implementations for MonadLog:
>
>    newtype IgnoreLogT m a = IgnoreLogT { runIgnoreLogT :: m a }
>
>    instance MonadLog (IgnoreLogT m) where
>      log _ = return ()
>
>
>    newtype ConsoleLogT m a = ConsoleLogT { runConsoleLogT :: m a }
>
>    instance MonadIO m => MonadLog (ConsoleLogT m) where
>      log msg = liftIO (putStrLn msg)
>
>
>    newtype StringLogT m a =
>      StringLogT { runStringLogT :: WriterT String m a }
>
>    instance MonadLog (StringLogT m) where
>      log msg = StringLogT $ tell msg
>
> Tillmann
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>