------------------------------------------------------------------------
-- |
-- Module      :  ALife.Creatur.Logger.SimpleLogger
-- 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.SimpleLogger
  (
    SimpleLogger,
    mkSimpleLogger
  ) where

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

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

-- | @'mkSimpleLogger' f@ creates a logger that will write to
--   file @f@.
mkSimpleLogger :: FilePath -> SimpleLogger
mkSimpleLogger :: FilePath -> SimpleLogger
mkSimpleLogger FilePath
f = Bool -> FilePath -> SimpleLogger
SimpleLogger Bool
False FilePath
f

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

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

initialise :: StateT SimpleLogger IO ()
initialise :: StateT SimpleLogger IO ()
initialise = do
  (FilePath
d,FilePath
_) <- (FilePath -> (FilePath, FilePath))
-> StateT SimpleLogger IO FilePath
-> StateT SimpleLogger IO (FilePath, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> (FilePath, FilePath)
splitFileName (StateT SimpleLogger IO FilePath
 -> StateT SimpleLogger IO (FilePath, FilePath))
-> StateT SimpleLogger IO FilePath
-> StateT SimpleLogger IO (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ (SimpleLogger -> FilePath) -> StateT SimpleLogger IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleLogger -> FilePath
logFilename
  IO () -> StateT SimpleLogger IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT SimpleLogger IO ())
-> IO () -> StateT SimpleLogger IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
d
  (SimpleLogger -> SimpleLogger) -> StateT SimpleLogger IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SimpleLogger
l -> SimpleLogger
l { initialised :: Bool
initialised=Bool
True } )

write' :: String -> SimpleLogger -> IO ()
write' :: FilePath -> SimpleLogger -> IO ()
write' FilePath
msg SimpleLogger
logger = do
  FilePath
ts <- IO FilePath
timestamp
  FilePath -> FilePath -> IO ()
appendFile (SimpleLogger -> FilePath
logFilename SimpleLogger
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"