module ALife.Creatur.Logger
(
Logger(..),
SimpleRotatingLogger,
mkSimpleRotatingLogger
) where
import ALife.Creatur.Util (modifyLift, getLift)
import Control.Monad (when, unless)
import Control.Monad.State (StateT, gets)
import Data.Time (formatTime, getZonedTime)
import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
import System.Locale (defaultTimeLocale)
class Logger l where
writeToLog :: String -> StateT l IO ()
data SimpleRotatingLogger = SimpleRotatingLogger {
initialised :: Bool,
directory :: FilePath,
logFilename :: FilePath,
expFilename :: FilePath,
maxRecordsPerFile :: Int,
recordCount :: Int
} deriving Show
mkSimpleRotatingLogger :: FilePath -> String -> Int -> SimpleRotatingLogger
mkSimpleRotatingLogger d pre n = SimpleRotatingLogger False d fLog fExp n (1)
where fLog = d ++ "/" ++ pre ++ ".log"
fExp = d ++ "/" ++ pre ++ ".exp"
instance Logger SimpleRotatingLogger where
writeToLog msg = do
initIfNeeded
modifyLift bumpRecordCount
getLift $ write' msg
initIfNeeded :: StateT SimpleRotatingLogger IO ()
initIfNeeded = do
isInitialised <- gets initialised
unless isInitialised $ modifyLift initialise
initialise :: SimpleRotatingLogger -> IO SimpleRotatingLogger
initialise logger = do
createDirectoryIfMissing True (directory logger)
let fExp = expFilename logger
expFileExists <- doesFileExist fExp
if expFileExists
then do
s <- readFile fExp
return $ logger { initialised=True, recordCount=read s}
else return $ logger { initialised=True, recordCount=0}
write' :: String -> SimpleRotatingLogger -> IO ()
write' msg logger = do
timestamp <-
fmap (formatTime defaultTimeLocale "%y%m%d%H%M%S%z") getZonedTime
appendFile (logFilename logger)
$ timestamp ++ "\t" ++ msg ++ "\n"
bumpRecordCount :: SimpleRotatingLogger -> IO SimpleRotatingLogger
bumpRecordCount logger = do
let n = 1 + recordCount logger
when (0 == n `mod` maxRecordsPerFile logger) $ rotateLog logger
writeFile (expFilename logger) (show n)
return logger{ recordCount=n }
rotateLog :: SimpleRotatingLogger -> IO ()
rotateLog logger = do
let f = logFilename logger
renameFile f $ f ++ '.' : (show $ recordCount logger)