Logging.hs

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
module SecondTransfer.MainLoop.Logging (
     nonce
#ifdef SECONDTRANSFER_MONITORING
    ,logit
#endif
    ) where

import           System.IO                 (stderr,openFile)
import qualified System.IO                 as SIO
import qualified Data.ByteString           as B
import qualified Data.ByteString.Char8     as Bch

-- Logging utilities
--import           System.Log.Formatter      (simpleLogFormatter)
--import           System.Log.Handler        (setFormatter, LogHandler)
--import           System.Log.Handler.Simple
-- import           System.Log.Handler.Syslog (Facility (..), Option (..), openlog)
--import           System.Log.Logger
import           System.IO.Unsafe          (unsafePerformIO)
import           System.Clock              as Cl

--import           Control.Concurrent.MVar
import           Control.Concurrent.Chan
import           Control.Concurrent

-- Simple thing to have a more generic logging utility
nonce :: ()
nonce = undefined


-- configureLoggingToSyslog :: IO ()
-- configureLoggingToSyslog = do
--     s <- openlog "RehMimic" [PID] DAEMON INFO >>=
--         \lh -> return $ setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")
--     setLoggerLevels s


#ifdef SECONDTRANSFER_MONITORING
data Logit = Logit Cl.TimeSpec B.ByteString


loggerChan :: Chan Logit
{-# NOINLINE loggerChan #-}
loggerChan = unsafePerformIO $ do
    chan <- newChan
    log_file <- openFile "LOGIT" SIO.WriteMode
    SIO.hSetBuffering log_file SIO.LineBuffering
    start_of_time <- Cl.getTime Cl.Monotonic
    forkIO $ readLoggerChan chan log_file start_of_time
    return chan

readLoggerChan ::  Chan Logit -> SIO.Handle -> Cl.TimeSpec -> IO ()
readLoggerChan chan_logit file_handle origin_time = do
    Logit timespec bs <- readChan chan_logit
    let
        Cl.TimeSpec sec' nsec' = timespec - origin_time
    SIO.hPutStr file_handle (show sec')
    SIO.hPutStr file_handle "|"
    SIO.hPutStr file_handle (show nsec')
    SIO.hPutStr file_handle "|"
    Bch.hPutStrLn file_handle bs
    SIO.hFlush file_handle
    readLoggerChan chan_logit file_handle origin_time

-- Simple logging function. It logs everything to a file named
-- "logit" in the current directory, adding a time-stamp
logit :: B.ByteString -> IO ()
logit !msg = do
    time <- Cl.getTime Cl.Monotonic
    let
        lg = Logit time msg
    writeChan loggerChan lg

#endif