module ALife.Creatur.Counter
(
Counter(..),
PersistentCounter,
mkPersistentCounter
) where
import ALife.Creatur.Clock (Clock, currentTime, incTime)
import ALife.Creatur.Util (modifyLift)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (StateT, get, gets, modify)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import System.FilePath (dropFileName)
import System.IO (hGetContents, withFile, Handle, IOMode(ReadMode))
import Text.Read (readEither)
class Counter c where
current :: StateT c IO Int
increment :: StateT c IO ()
data PersistentCounter = PersistentCounter {
cInitialised :: Bool,
cValue :: Int,
cFilename :: FilePath
} deriving (Show, Eq)
mkPersistentCounter :: FilePath -> PersistentCounter
mkPersistentCounter = PersistentCounter False (1)
instance Counter PersistentCounter where
current = initIfNeeded >> gets cValue
increment = do
initIfNeeded
modify (\c -> c { cValue=1 + cValue c })
k <- get
liftIO $ store k
store :: PersistentCounter -> IO ()
store counter = do
let f = cFilename counter
createDirectoryIfMissing True $ dropFileName f
writeFile f $ show (cValue counter)
initIfNeeded :: StateT PersistentCounter IO ()
initIfNeeded = do
isInitialised <- gets cInitialised
unless isInitialised $ modifyLift initialise
initialise :: PersistentCounter -> IO PersistentCounter
initialise counter = do
let f = cFilename counter
fExists <- doesFileExist f
if fExists
then do
x <- withFile f ReadMode readCounter
case x of
Left msg -> error $ "Unable to read counter from " ++ f ++ ": " ++ msg
Right c -> return $ counter { cInitialised=True, cValue=c }
else do
let k = counter { cInitialised=True, cValue=0 }
return k
instance Clock PersistentCounter where
currentTime = current
incTime = increment
readCounter :: Handle -> IO (Either String Int)
readCounter h = do
s <- hGetContents h
let x = readEither s
case x of
Left msg -> return $ Left (msg ++ "\"" ++ s ++ "\"")
Right c -> return $ Right c