src/Logger.hs

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