module ALife.Creatur.Counter
(
Counter(..),
PersistentCounter,
mkPersistentCounter
) where
import ALife.Creatur.Clock (Clock, currentTime, incTime)
import ALife.Creatur.Util (modifyLift, getLift)
import Control.Monad (unless)
import Control.Monad.State (StateT, gets, modify)
import System.Directory (doesFileExist)
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
mkPersistentCounter :: FilePath -> PersistentCounter
mkPersistentCounter = PersistentCounter False (1)
instance Counter PersistentCounter where
current = initIfNeeded >> gets cValue
increment = do
modify (\c -> c { cValue=1 + cValue c })
getLift store
store :: PersistentCounter -> IO ()
store counter = writeFile (cFilename counter) $ 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 return $ counter { cInitialised=True, cValue=0 }
instance Clock PersistentCounter where
currentTime = current
incTime = increment
readCounter :: Handle -> IO (Either String Int)
readCounter h = do
s <- hGetContents h
let x = readEither s :: Either String Int
case x of
Left msg -> return $ Left (msg ++ "\"" ++ s ++ "\"")
Right c -> return $ Right c