[PATCH stable-2.12 12/18] Add an alias for WriterLogT Identity

['Petr Pudlak' via ganeti-devel]

.. and corresponding helper functions.

Signed-off-by: Petr Pudlak <pud...@google.com>
---
 src/Ganeti/Logging/WriterLog.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/src/Ganeti/Logging/WriterLog.hs b/src/Ganeti/Logging/WriterLog.hs
index 791b331..d411815 100644
--- a/src/Ganeti/Logging/WriterLog.hs
+++ b/src/Ganeti/Logging/WriterLog.hs
@@ -28,8 +28,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Ganeti.Logging.WriterLog
   ( WriterLogT
+  , WriterLog
   , runWriterLogT
+  , runWriterLog
+  , dumpLogSeq
   , execWriterLogT
+  , execWriterLog
   ) where
 
 import Control.Applicative
@@ -39,6 +43,7 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Control
 import Control.Monad.Writer
 import qualified Data.Foldable as F
+import Data.Functor.Identity
 import Data.Sequence
 
 import Ganeti.Logging
@@ -53,10 +58,16 @@ type WriterSeq = WriterT LogSeq
 newtype WriterLogT m a =
   WriterLogT { unwrapWriterLogT :: WriterSeq m a }
 
+type WriterLog = WriterLogT Identity
+
 -- Runs a 'WriterLogT', returning the result and accumulated messages.
 runWriterLogT :: WriterLogT m a -> m (a, LogSeq)
 runWriterLogT = runWriterT . unwrapWriterLogT
 
+-- Runs a 'WriterLog', returning the result and accumulated messages.
+runWriterLog :: WriterLog a -> (a, LogSeq)
+runWriterLog = runIdentity . runWriterLogT
+
 -- | Runs a 'WriterLogT', and when it finishes, resends all log messages
 -- to the underlying monad that implements 'MonadLog'.
 --
@@ -68,6 +79,18 @@ execWriterLogT k = do
   F.mapM_ (uncurry logAt) msgs
   return r
 
+-- | Sends all log messages to the a monad that implements 'MonadLog'.
+dumpLogSeq :: (MonadLog m) => LogSeq -> m ()
+dumpLogSeq = F.mapM_ (uncurry logAt)
+
+-- | Runs a 'WriterLog', and when it finishes, resends all log messages
+-- to the a monad that implements 'MonadLog'.
+execWriterLog :: (MonadLog m) => WriterLog a -> m a
+execWriterLog k = do
+  let (r, msgs) = runWriterLog k
+  dumpLogSeq msgs
+  return r
+
 instance (Monad m) => Functor (WriterLogT m) where
   fmap = liftM
 
-- 
2.0.0.526.g5318336