
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
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe