From: Divam Date: Sat, 28 Feb 2015 16:08:11 +0000 (+0530) Subject: Logger implementation code. Fixes #6. Logging to file remaining X-Git-Url: https://git.rkrishnan.org/%5B/%5D%20/uri/vdrive?a=commitdiff_plain;h=59d1e2ea26546ac0c735c62078def45d063c85c4;p=functorrent.git Logger implementation code. Fixes #6. Logging to file remaining --- diff --git a/src/Logger.hs b/src/Logger.hs new file mode 100644 index 0000000..5863cce --- /dev/null +++ b/src/Logger.hs @@ -0,0 +1,55 @@ +module Logger ( + Logger + , initLogger + , logMessage + , logStop + ) where + +import Control.Concurrent + +-- The below logger implementation has been taken from +-- Parallel and Concurrent Programming in Haskell, Chapter 7 +-- The logger is implemented in a concurrent thread. + +-- Here the (MVar LogCommand) is used for actual thread communication +-- So if multiple threads try to log, then the logger will be thread-safe +-- Also the 'loop' in logger will wait for the message to come. +-- +-- The MVar in stop is just to ensure the logger thread executes completely +-- Before exiting the main application. +-- +data Logger = Logger (MVar LogCommand) +data LogCommand = Message String | Stop (MVar ()) + +initLogger :: IO Logger +initLogger = do + m <- newEmptyMVar + let l = Logger m + _ <- forkIO (logger l) + return l + +logger :: Logger -> IO () +logger (Logger m) = loop + where + loop = do + cmd <- takeMVar m + case cmd of + Message msg -> do + -- We can alternatively put the message to a file + putStrLn msg + -- Recursive + loop + Stop s -> do + putStrLn "FuncTorrent: Exit succesfully" + putMVar s () + +-- Send log message to logger +logMessage :: Logger -> String -> IO () +logMessage (Logger m) s = putMVar m (Message s) + +logStop :: Logger -> IO () +logStop (Logger m) = do + s <- newEmptyMVar + putMVar m (Stop s) + -- Wait for logger to complete the logging + takeMVar s diff --git a/src/Main.hs b/src/Main.hs index 50eb5d1..2213ac9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,9 +11,10 @@ import System.Environment (getArgs) import System.Exit (exitSuccess) import Tracker (connect, prepareRequest) import Text.ParserCombinators.Parsec (ParseError) +import Logger -printError :: ParseError -> IO () -printError e = putStrLn $ "parse error: " ++ show e +printError :: ParseError -> Logger -> IO () +printError e l = logMessage l $ "parse error: \n" ++ show e peerId :: String peerId = "-HS0001-*-*-20150215" @@ -32,16 +33,23 @@ parse _ = exit main :: IO () main = do args <- getArgs + logR <- initLogger + logMessage logR $ "Starting parsing input file: " ++ (concat args) torrentStr <- parse args case decode torrentStr of Right d -> case mkMetaInfo d of - Nothing -> putStrLn "parse error" + Nothing -> logMessage logR "parse error" Just m -> do let len = lengthInBytes $ info m (Bdict d') = d body <- pack <$> connect (announce m) (prepareRequest d' peerId len) - print $ getPeers $ getPeerResponse body - print $ length $ handShakeMsg d' peerId - Left e -> printError e - putStrLn "done" + + let peerResponse = show $ getPeers $ getPeerResponse body + logMessage logR $ "Peers List : " ++ peerResponse + + let hsMsgLen = show $ length $ handShakeMsg d' peerId + logMessage logR $ "Hand-shake message length : " ++ hsMsgLen + + Left e -> printError e logR + logStop logR