{-# LANGUAGE OverloadedStrings #-}
module Purebred.System.Logging
( setupLogsink
) where
import Data.Time.LocalTime (getZonedTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Control.Monad (forever)
import Control.Concurrent (forkIO)
import Control.Concurrent.STM (atomically, newTQueueIO, readTQueue, writeTQueue)
import System.IO (BufferMode(LineBuffering), IOMode(AppendMode), hSetBuffering, openFile)
import GHC.IO.Handle (Handle)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
setupLogsink :: Maybe FilePath -> IO (T.Text -> IO ())
setupLogsink debugFile =
case debugFile of
Nothing -> pure $ \_ -> pure ()
Just fp -> do
h <- openFile fp AppendMode
hSetBuffering h LineBuffering
q <- newTQueueIO
_ <- forkIO $ forever $ atomically (readTQueue q) >>= log_ h
pure $ atomically . writeTQueue q
log_ :: Handle -> T.Text -> IO ()
log_ h logtext = do
dateTimeNow <- getZonedTime
let timestamp = T.pack $ formatTime defaultTimeLocale "%c" dateTimeNow
T.hPutStrLn h $ timestamp <> " " <> logtext