------------------------------------------------------------------------
-- |
-- Module      :  ALife.Creatur.Logger.SimpleRotatingLogger
-- Copyright   :  (c) 2011-2021 Amy de Buitléir
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- A simple rotating log, tailored to the needs of the Créatúr 
-- framework.
--
------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module ALife.Creatur.Logger.SimpleRotatingLogger
  (
    Logger(..),
    SimpleRotatingLogger,
    mkSimpleRotatingLogger
  ) where

import ALife.Creatur.Util (getLift)
import ALife.Creatur.Logger (Logger(..), timestamp)
import Control.Conditional (whenM, unlessM)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (StateT, gets, modify)
import System.Directory (createDirectoryIfMissing, doesFileExist,
  renameFile)

-- | A rotating logger.
data SimpleRotatingLogger = SimpleRotatingLogger {
    SimpleRotatingLogger -> Bool
initialised :: Bool,
    SimpleRotatingLogger -> FilePath
directory :: FilePath,
    SimpleRotatingLogger -> FilePath
logFilename :: FilePath,
    SimpleRotatingLogger -> FilePath
expFilename :: FilePath,
    SimpleRotatingLogger -> Int
maxRecordsPerFile :: Int,
    SimpleRotatingLogger -> Int
recordCount :: Int,
    SimpleRotatingLogger -> Int
logCount :: Int
  } deriving (Int -> SimpleRotatingLogger -> ShowS
[SimpleRotatingLogger] -> ShowS
SimpleRotatingLogger -> FilePath
(Int -> SimpleRotatingLogger -> ShowS)
-> (SimpleRotatingLogger -> FilePath)
-> ([SimpleRotatingLogger] -> ShowS)
-> Show SimpleRotatingLogger
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SimpleRotatingLogger] -> ShowS
$cshowList :: [SimpleRotatingLogger] -> ShowS
show :: SimpleRotatingLogger -> FilePath
$cshow :: SimpleRotatingLogger -> FilePath
showsPrec :: Int -> SimpleRotatingLogger -> ShowS
$cshowsPrec :: Int -> SimpleRotatingLogger -> ShowS
Show, SimpleRotatingLogger -> SimpleRotatingLogger -> Bool
(SimpleRotatingLogger -> SimpleRotatingLogger -> Bool)
-> (SimpleRotatingLogger -> SimpleRotatingLogger -> Bool)
-> Eq SimpleRotatingLogger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleRotatingLogger -> SimpleRotatingLogger -> Bool
$c/= :: SimpleRotatingLogger -> SimpleRotatingLogger -> Bool
== :: SimpleRotatingLogger -> SimpleRotatingLogger -> Bool
$c== :: SimpleRotatingLogger -> SimpleRotatingLogger -> Bool
Eq)

-- | @'mkSimpleRotatingLogger' d prefix n@ creates a logger that will write to
--   directory @d@. The log \"rotates\" (starts a new log file) every @n@
--   records. Log files follow the naming convention @prefix@./k/, where /k/ 
--   is the number of the last log record contained in the file. If logging
--   has already been set up in @directory@, then logging will continue where
--   it left off; appending to the most recent log file.
mkSimpleRotatingLogger :: FilePath -> String -> Int -> SimpleRotatingLogger
mkSimpleRotatingLogger :: FilePath -> FilePath -> Int -> SimpleRotatingLogger
mkSimpleRotatingLogger FilePath
d FilePath
pre Int
n =
  Bool
-> FilePath
-> FilePath
-> FilePath
-> Int
-> Int
-> Int
-> SimpleRotatingLogger
SimpleRotatingLogger Bool
False FilePath
d FilePath
fLog FilePath
fExp Int
n Int
0 Int
0
  where fLog :: FilePath
fLog = FilePath
d FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pre FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".log"
        fExp :: FilePath
fExp = FilePath
d FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pre FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".exp"

instance Logger SimpleRotatingLogger where
  writeToLog :: FilePath -> StateT SimpleRotatingLogger IO ()
writeToLog FilePath
msg = do
    StateT SimpleRotatingLogger IO ()
initIfNeeded
    StateT SimpleRotatingLogger IO ()
bumpRecordCount
    StateT SimpleRotatingLogger IO ()
rotateLogIfNeeded
    (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) s. Monad m => (s -> m ()) -> StateT s m ()
getLift ((SimpleRotatingLogger -> IO ())
 -> StateT SimpleRotatingLogger IO ())
-> (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SimpleRotatingLogger -> IO ()
write' FilePath
msg
    StateT SimpleRotatingLogger IO ()
saveState

initIfNeeded :: StateT SimpleRotatingLogger IO ()
initIfNeeded :: StateT SimpleRotatingLogger IO ()
initIfNeeded =
  StateT SimpleRotatingLogger IO Bool
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall bool (m :: * -> *).
(ToBool bool, Boolean bool, Monad m) =>
m bool -> m () -> m ()
unlessM ((SimpleRotatingLogger -> Bool)
-> StateT SimpleRotatingLogger IO Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Bool
initialised) StateT SimpleRotatingLogger IO ()
initialise

initialise :: StateT SimpleRotatingLogger IO ()
initialise :: StateT SimpleRotatingLogger IO ()
initialise = do
  FilePath
d <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
directory
  IO () -> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT SimpleRotatingLogger IO ())
-> IO () -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
d
  FilePath
fExp <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
expFilename
  StateT SimpleRotatingLogger IO Bool
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall bool (m :: * -> *).
(ToBool bool, Monad m) =>
m bool -> m () -> m ()
whenM (IO Bool -> StateT SimpleRotatingLogger IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT SimpleRotatingLogger IO Bool)
-> IO Bool -> StateT SimpleRotatingLogger IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fExp) StateT SimpleRotatingLogger IO ()
readState
  (SimpleRotatingLogger -> SimpleRotatingLogger)
-> StateT SimpleRotatingLogger IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SimpleRotatingLogger
l -> SimpleRotatingLogger
l { initialised :: Bool
initialised=Bool
True } )
  FilePath -> StateT SimpleRotatingLogger IO ()
debug FilePath
"initialise"

debug :: String -> StateT SimpleRotatingLogger IO ()
debug :: FilePath -> StateT SimpleRotatingLogger IO ()
debug FilePath
s = do
  Int
n <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
recordCount
  Int
k <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
logCount
  (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) s. Monad m => (s -> m ()) -> StateT s m ()
getLift ((SimpleRotatingLogger -> IO ())
 -> StateT SimpleRotatingLogger IO ())
-> (FilePath -> SimpleRotatingLogger -> IO ())
-> FilePath
-> StateT SimpleRotatingLogger IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> SimpleRotatingLogger -> IO ()
write' (FilePath -> StateT SimpleRotatingLogger IO ())
-> FilePath -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"DEBUG " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": n=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": k=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k 
  FilePath
fExp <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
expFilename
  StateT SimpleRotatingLogger IO Bool
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall bool (m :: * -> *).
(ToBool bool, Monad m) =>
m bool -> m () -> m ()
whenM (IO Bool -> StateT SimpleRotatingLogger IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT SimpleRotatingLogger IO Bool)
-> IO Bool -> StateT SimpleRotatingLogger IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fExp) (StateT SimpleRotatingLogger IO ()
 -> StateT SimpleRotatingLogger IO ())
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath
s' <- IO FilePath -> StateT SimpleRotatingLogger IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> StateT SimpleRotatingLogger IO FilePath)
-> IO FilePath -> StateT SimpleRotatingLogger IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
fExp
    let (Int
n',Int
k') = FilePath -> (Int, Int)
forall a. Read a => FilePath -> a
read FilePath
s' :: (Int,Int)
    (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) s. Monad m => (s -> m ()) -> StateT s m ()
getLift ((SimpleRotatingLogger -> IO ())
 -> StateT SimpleRotatingLogger IO ())
-> (FilePath -> SimpleRotatingLogger -> IO ())
-> FilePath
-> StateT SimpleRotatingLogger IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> SimpleRotatingLogger -> IO ()
write' (FilePath -> StateT SimpleRotatingLogger IO ())
-> FilePath -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"DEBUG2 " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": n'=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": k'=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k' 
  
readState :: StateT SimpleRotatingLogger IO ()
readState :: StateT SimpleRotatingLogger IO ()
readState = do
  FilePath
fExp <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
expFilename
  FilePath
s <- IO FilePath -> StateT SimpleRotatingLogger IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> StateT SimpleRotatingLogger IO FilePath)
-> IO FilePath -> StateT SimpleRotatingLogger IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
fExp
  let (Int
n,Int
k) = FilePath -> (Int, Int)
forall a. Read a => FilePath -> a
read FilePath
s
  (SimpleRotatingLogger -> SimpleRotatingLogger)
-> StateT SimpleRotatingLogger IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SimpleRotatingLogger
l -> SimpleRotatingLogger
l { recordCount :: Int
recordCount=Int
n, logCount :: Int
logCount=Int
k } )

saveState :: StateT SimpleRotatingLogger IO ()
saveState :: StateT SimpleRotatingLogger IO ()
saveState = do
  FilePath
e <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
expFilename
  Int
n <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
recordCount
  Int
k <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
logCount
  IO () -> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT SimpleRotatingLogger IO ())
-> (FilePath -> IO ())
-> FilePath
-> StateT SimpleRotatingLogger IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
writeFile FilePath
e (FilePath -> StateT SimpleRotatingLogger IO ())
-> FilePath -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"," FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"

write' :: String -> SimpleRotatingLogger -> IO ()
write' :: FilePath -> SimpleRotatingLogger -> IO ()
write' FilePath
msg SimpleRotatingLogger
logger = do
  FilePath
ts <- IO FilePath
timestamp
  FilePath -> FilePath -> IO ()
appendFile (SimpleRotatingLogger -> FilePath
logFilename SimpleRotatingLogger
logger) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
ts FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\t" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"

bumpRecordCount :: StateT SimpleRotatingLogger IO ()
bumpRecordCount :: StateT SimpleRotatingLogger IO ()
bumpRecordCount = (SimpleRotatingLogger -> SimpleRotatingLogger)
-> StateT SimpleRotatingLogger IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SimpleRotatingLogger
l -> SimpleRotatingLogger
l { recordCount :: Int
recordCount=SimpleRotatingLogger -> Int
recordCount SimpleRotatingLogger
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 })

rotateLogIfNeeded :: StateT SimpleRotatingLogger IO ()
rotateLogIfNeeded :: StateT SimpleRotatingLogger IO ()
rotateLogIfNeeded = do
  FilePath -> StateT SimpleRotatingLogger IO ()
debug FilePath
"rotateLogIfNeeded"
  Int
n <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
recordCount
  Int
m <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
maxRecordsPerFile
  Bool
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m) (StateT SimpleRotatingLogger IO ()
 -> StateT SimpleRotatingLogger IO ())
-> StateT SimpleRotatingLogger IO ()
-> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ StateT SimpleRotatingLogger IO ()
rotateLog
  
rotateLog :: StateT SimpleRotatingLogger IO ()
rotateLog :: StateT SimpleRotatingLogger IO ()
rotateLog = do
  FilePath -> StateT SimpleRotatingLogger IO ()
debug FilePath
"rotateLog"
  FilePath
f <- (SimpleRotatingLogger -> FilePath)
-> StateT SimpleRotatingLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> FilePath
logFilename
  Int
n <- (SimpleRotatingLogger -> Int) -> StateT SimpleRotatingLogger IO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleRotatingLogger -> Int
logCount
  let fPrev :: FilePath
fPrev = FilePath
f FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n
  (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) s. Monad m => (s -> m ()) -> StateT s m ()
getLift ((SimpleRotatingLogger -> IO ())
 -> StateT SimpleRotatingLogger IO ())
-> (FilePath -> SimpleRotatingLogger -> IO ())
-> FilePath
-> StateT SimpleRotatingLogger IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> SimpleRotatingLogger -> IO ()
write' (FilePath -> StateT SimpleRotatingLogger IO ())
-> FilePath -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Continued in log " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  IO () -> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT SimpleRotatingLogger IO ())
-> IO () -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile FilePath
f FilePath
fPrev
  (SimpleRotatingLogger -> IO ())
-> StateT SimpleRotatingLogger IO ()
forall (m :: * -> *) s. Monad m => (s -> m ()) -> StateT s m ()
getLift ((SimpleRotatingLogger -> IO ())
 -> StateT SimpleRotatingLogger IO ())
-> (FilePath -> SimpleRotatingLogger -> IO ())
-> FilePath
-> StateT SimpleRotatingLogger IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> SimpleRotatingLogger -> IO ()
write' (FilePath -> StateT SimpleRotatingLogger IO ())
-> FilePath -> StateT SimpleRotatingLogger IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Continued from log " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n
  (SimpleRotatingLogger -> SimpleRotatingLogger)
-> StateT SimpleRotatingLogger IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SimpleRotatingLogger
l -> SimpleRotatingLogger
l { recordCount :: Int
recordCount=Int
0, logCount :: Int
logCount=Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 })