src/FuncTorrent/Logger.hs

   1 {-
   2 Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3
   4 This file is part of FuncTorrent.
   5
   6 FuncTorrent is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 FuncTorrent is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  18 -}
  19
  20 module FuncTorrent.Logger (
  21       initLogger
  22     , logMessage
  23     , logStop
  24     ) where
  25
  26 import Control.Concurrent
  27
  28 -- The below logger implementation has been taken from
  29 -- Parallel and Concurrent Programming in Haskell, Chapter 7
  30 -- The logger is implemented in a concurrent thread.
  31
  32 -- Here the (MVar LogCommand) is used for actual thread communication
  33 -- So if multiple threads try to log, then the logger will be thread-safe
  34 -- Also the 'loop' in logger will wait for the message to come.
  35 --
  36 -- The MVar in stop is just to ensure the logger thread executes completely
  37 -- Before exiting the main application.
  38 data Logger = Logger (MVar LogCommand)
  39 data LogCommand = Message String | Stop (MVar ())
  40
  41 initLogger :: IO Logger
  42 initLogger = do
  43     m <- newEmptyMVar
  44     let l = Logger m
  45     _ <- forkIO (logger l)
  46     return l
  47
  48 logger :: Logger -> IO ()
  49 logger (Logger m) = loop
  50     where
  51         loop = do
  52             cmd <- takeMVar m
  53             case cmd of
  54                  Message msg -> do
  55                      -- We can alternatively put the message to a file
  56                      putStrLn msg
  57                      -- Recursive
  58                      loop
  59                  Stop s -> do
  60                      putStrLn "FuncTorrent: Exit succesfully"
  61                      putMVar s ()
  62
  63 -- Send log message to logger
  64 logMessage :: Logger -> String -> IO ()
  65 logMessage (Logger m) s = putMVar m (Message s)
  66
  67 logStop :: Logger -> IO ()
  68 logStop (Logger m) = do
  69     s <- newEmptyMVar
  70     putMVar m (Stop s)
  71     -- Wait for logger to complete the logging
  72     takeMVar s