src/FuncTorrent/Logger.hs

   1 module FuncTorrent.Logger (
   2       initLogger
   3     , logMessage
   4     , logStop
   5     ) where
   6
   7 import Control.Concurrent
   8
   9 -- The below logger implementation has been taken from
  10 -- Parallel and Concurrent Programming in Haskell, Chapter 7
  11 -- The logger is implemented in a concurrent thread.
  12
  13 -- Here the (MVar LogCommand) is used for actual thread communication
  14 -- So if multiple threads try to log, then the logger will be thread-safe
  15 -- Also the 'loop' in logger will wait for the message to come.
  16 --
  17 -- The MVar in stop is just to ensure the logger thread executes completely
  18 -- Before exiting the main application.
  19 data Logger = Logger (MVar LogCommand)
  20 data LogCommand = Message String | Stop (MVar ())
  21
  22 initLogger :: IO Logger
  23 initLogger = do
  24     m <- newEmptyMVar
  25     let l = Logger m
  26     _ <- forkIO (logger l)
  27     return l
  28
  29 logger :: Logger -> IO ()
  30 logger (Logger m) = loop
  31     where
  32         loop = do
  33             cmd <- takeMVar m
  34             case cmd of
  35                  Message msg -> do
  36                      -- We can alternatively put the message to a file
  37                      putStrLn msg
  38                      -- Recursive
  39                      loop
  40                  Stop s -> do
  41                      putStrLn "FuncTorrent: Exit succesfully"
  42                      putMVar s ()
  43
  44 -- Send log message to logger
  45 logMessage :: Logger -> String -> IO ()
  46 logMessage (Logger m) s = putMVar m (Message s)
  47
  48 logStop :: Logger -> IO ()
  49 logStop (Logger m) = do
  50     s <- newEmptyMVar
  51     putMVar m (Stop s)
  52     -- Wait for logger to complete the logging
  53     takeMVar s