[Haskell-cafe] Writer + log each computation to stdout
Alex Vieth
alex at lagoa.com
Tue Nov 26 05:27:09 UTC 2013
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
>
More information about the Haskell-Cafe
mailing list