src/Logger.hs

   1 module 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 --
  20 data Logger = Logger (MVar LogCommand)
  21 data LogCommand = Message String | Stop (MVar ())
  22
  23 initLogger :: IO Logger
  24 initLogger = do
  25     m <- newEmptyMVar
  26     let l = Logger m
  27     _ <- forkIO (logger l)
  28     return l
  29
  30 logger :: Logger -> IO ()
  31 logger (Logger m) = loop
  32     where
  33         loop = do
  34             cmd <- takeMVar m
  35             case cmd of
  36                  Message msg -> do
  37                      -- We can alternatively put the message to a file
  38                      putStrLn msg
  39                      -- Recursive
  40                      loop
  41                  Stop s -> do
  42                      putStrLn "FuncTorrent: Exit succesfully"
  43                      putMVar s ()
  44
  45 -- Send log message to logger
  46 logMessage :: Logger -> String -> IO ()
  47 logMessage (Logger m) s = putMVar m (Message s)
  48
  49 logStop :: Logger -> IO ()
  50 logStop (Logger m) = do
  51     s <- newEmptyMVar
  52     putMVar m (Stop s)
  53     -- Wait for logger to complete the logging
  54     takeMVar s