creatur 5.4.0 → 5.4.1

raw patch · 5 files changed

+204/−80 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• creatur.cabal +4/−2
• src/ALife/Creatur/Logger.hs +5/−68
• src/ALife/Creatur/Logger/SimpleLogger.hs +59/−0
• src/ALife/Creatur/Logger/SimpleRotatingLogger.hs +125/−0
• src/ALife/Creatur/Universe.hs +11/−10

@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.4.0+Version:           5.4.1 Stability:         experimental Synopsis:          Framework for artificial life experiments. Description:       A software framework for automating experiments@@ -36,7 +36,7 @@ source-repository this   type:     git   location: https://github.com/mhwombat/creatur.git-  tag:      5.3.2+  tag:      5.4.1  library   GHC-Options:      -Wall -fno-warn-orphans@@ -59,6 +59,8 @@                     ALife.Creatur.Genetics.Reproduction.Sexual,                     ALife.Creatur.Genetics.Reproduction.SimplifiedSexual,                     ALife.Creatur.Logger,+                    ALife.Creatur.Logger.SimpleLogger,+                    ALife.Creatur.Logger.SimpleRotatingLogger,                     ALife.Creatur.Namer,                     ALife.Creatur.Universe,                     ALife.Creatur.Task,

@@ -16,80 +16,17 @@ module ALife.Creatur.Logger   (     Logger(..),-    SimpleRotatingLogger,-    mkSimpleRotatingLogger+    timestamp   ) where -import ALife.Creatur.Util (modifyLift, getLift)-import Control.Monad (when, unless)-import Control.Monad.State (StateT, gets)+import Control.Monad.State (StateT) import Data.Time (formatTime, getZonedTime)-import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile) import System.Locale (defaultTimeLocale)  class Logger l where   -- | @'writeToLog' msg@ formats and writes a new log message.   writeToLog :: String -> StateT l IO () --- | A rotating logger.-data SimpleRotatingLogger = SimpleRotatingLogger {-    initialised :: Bool,-    directory :: FilePath,-    logFilename :: FilePath,-    expFilename :: FilePath,-    maxRecordsPerFile :: Int,-    recordCount :: Int-  } deriving (Show, 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 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)-+timestamp :: IO String+timestamp =+  fmap (formatTime defaultTimeLocale "%y%m%d%H%M%S%z") getZonedTime

@@ -0,0 +1,59 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.Logger.SimpleLogger+-- Copyright   :  (c) Amy de Buitléir 2011-2014+-- 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 {+    initialised :: Bool,+    logFilename :: FilePath+  } deriving (Show, Eq)++-- | @'mkSimpleLogger' f@ creates a logger that will write to+--   file @f@.+mkSimpleLogger :: FilePath -> SimpleLogger+mkSimpleLogger f = SimpleLogger False f++instance Logger SimpleLogger where+  writeToLog msg = do+    initIfNeeded+    getLift $ write' msg++initIfNeeded :: StateT SimpleLogger IO ()+initIfNeeded =+  unlessM (gets initialised) initialise++initialise :: StateT SimpleLogger IO ()+initialise = do+  (d,_) <- fmap splitFileName $ gets logFilename+  liftIO $ createDirectoryIfMissing True d+  modify (\l -> l { initialised=True } )++write' :: String -> SimpleLogger -> IO ()+write' msg logger = do+  ts <- timestamp+  appendFile (logFilename logger) $ ts ++ "\t" ++ msg ++ "\n"

@@ -0,0 +1,125 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.Logger.SimpleRotatingLogger+-- Copyright   :  (c) Amy de Buitléir 2011-2014+-- 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 {+    initialised :: Bool,+    directory :: FilePath,+    logFilename :: FilePath,+    expFilename :: FilePath,+    maxRecordsPerFile :: Int,+    recordCount :: Int,+    logCount :: Int+  } deriving (Show, 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 d pre n =+  SimpleRotatingLogger False d fLog fExp n 0 0+  where fLog = d ++ "/" ++ pre ++ ".log"+        fExp = d ++ "/" ++ pre ++ ".exp"++instance Logger SimpleRotatingLogger where+  writeToLog msg = do+    initIfNeeded+    bumpRecordCount+    rotateLogIfNeeded+    getLift $ write' msg+    saveState++initIfNeeded :: StateT SimpleRotatingLogger IO ()+initIfNeeded =+  unlessM (gets initialised) initialise++initialise :: StateT SimpleRotatingLogger IO ()+initialise = do+  d <- gets directory+  liftIO $ createDirectoryIfMissing True d+  fExp <- gets expFilename+  whenM (liftIO $ doesFileExist fExp) readState+  modify (\l -> l { initialised=True } )+  debug "initialise"++debug :: String -> StateT SimpleRotatingLogger IO ()+debug s = do+  n <- gets recordCount+  k <- gets logCount+  getLift . write' $ "DEBUG " ++ s ++ ": n=" ++ show n ++ ": k=" ++ show k +  fExp <- gets expFilename+  whenM (liftIO $ doesFileExist fExp) $ do+    s' <- liftIO $ readFile fExp+    let (n',k') = read s' :: (Int,Int)+    getLift . write' $ "DEBUG2 " ++ s ++ ": n'=" ++ show n' ++ ": k'=" ++ show k' +  +readState :: StateT SimpleRotatingLogger IO ()+readState = do+  fExp <- gets expFilename+  s <- liftIO $ readFile fExp+  let (n,k) = read s+  modify (\l -> l { recordCount=n, logCount=k } )++saveState :: StateT SimpleRotatingLogger IO ()+saveState = do+  e <- gets expFilename+  n <- gets recordCount+  k <- gets logCount+  liftIO . writeFile e $ "(" ++ show n ++ "," ++ show k ++ ")"++write' :: String -> SimpleRotatingLogger -> IO ()+write' msg logger = do+  ts <- timestamp+  appendFile (logFilename logger) $ ts ++ "\t" ++ msg ++ "\n"++bumpRecordCount :: StateT SimpleRotatingLogger IO ()+bumpRecordCount = modify (\l -> l { recordCount=recordCount l + 1 })++rotateLogIfNeeded :: StateT SimpleRotatingLogger IO ()+rotateLogIfNeeded = do+  debug "rotateLogIfNeeded"+  n <- gets recordCount+  m <- gets maxRecordsPerFile+  when (n >= m) $ rotateLog+  +rotateLog :: StateT SimpleRotatingLogger IO ()+rotateLog = do+  debug "rotateLog"+  f <- gets logFilename+  n <- gets logCount+  let fPrev = f ++ '.' : show n+  getLift . write' $ "Continued in log " ++ show (n+1)+  liftIO $ renameFile f fPrev+  getLift . write' $ "Continued from log " ++ show n+  modify (\l -> l { recordCount=0, logCount=n+1 })

@@ -59,6 +59,7 @@ import qualified ALife.Creatur.Database.FileSystem as FS import qualified ALife.Creatur.Database.CachedFileSystem as CFS import qualified ALife.Creatur.Logger as L+import qualified ALife.Creatur.Logger.SimpleLogger as SL import ALife.Creatur.Util (stateMap, shuffle) import Control.Monad.IO.Class (liftIO) import Control.Monad.Random (evalRandIO)@@ -273,7 +274,7 @@ data SimpleUniverse a = SimpleUniverse   {     suClock :: K.PersistentCounter,-    suLogger :: L.SimpleRotatingLogger,+    suLogger :: SL.SimpleLogger,     suDB :: FS.FSDatabase a,     suNamer :: N.SimpleNamer,     suChecklist :: CL.PersistentChecklist@@ -284,7 +285,7 @@   type Clock (SimpleUniverse a) = K.PersistentCounter   clock = suClock   setClock u c = u { suClock=c }-  type Logger (SimpleUniverse a) = L.SimpleRotatingLogger+  type Logger (SimpleUniverse a) = SL.SimpleLogger   logger = suLogger   setLogger u l = u { suLogger=l }   type AgentDB (SimpleUniverse a) = FS.FSDatabase a@@ -297,11 +298,11 @@   checklist = suChecklist   setChecklist u cl = u { suChecklist=cl } -mkSimpleUniverse :: String -> FilePath -> Int -> SimpleUniverse a-mkSimpleUniverse name dir rotateCount+mkSimpleUniverse :: String -> FilePath -> SimpleUniverse a+mkSimpleUniverse name dir   = SimpleUniverse c l d n cl   where c = K.mkPersistentCounter (dir ++ "/clock")-        l = L.mkSimpleRotatingLogger (dir ++ "/log/") name rotateCount+        l = SL.mkSimpleLogger (dir ++ "/log/" ++ name ++ ".log")         d = FS.mkFSDatabase (dir ++ "/db")         n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")@@ -309,7 +310,7 @@ data CachedUniverse a = CachedUniverse   {     cuClock :: K.PersistentCounter,-    cuLogger :: L.SimpleRotatingLogger,+    cuLogger :: SL.SimpleLogger,     cuDB :: CFS.CachedFSDatabase a,     cuNamer :: N.SimpleNamer,     cuChecklist :: CL.PersistentChecklist@@ -320,7 +321,7 @@   type Clock (CachedUniverse a) = K.PersistentCounter   clock = cuClock   setClock u c = u { cuClock=c }-  type Logger (CachedUniverse a) = L.SimpleRotatingLogger+  type Logger (CachedUniverse a) = SL.SimpleLogger   logger = cuLogger   setLogger u l = u { cuLogger=l }   type AgentDB (CachedUniverse a) = CFS.CachedFSDatabase a@@ -333,11 +334,11 @@   checklist = cuChecklist   setChecklist u cl = u { cuChecklist=cl } -mkCachedUniverse :: String -> FilePath -> Int -> Int -> CachedUniverse a-mkCachedUniverse name dir rotateCount cacheSize+mkCachedUniverse :: String -> FilePath -> Int -> CachedUniverse a+mkCachedUniverse name dir cacheSize   = CachedUniverse c l d n cl   where c = K.mkPersistentCounter (dir ++ "/clock")-        l = L.mkSimpleRotatingLogger (dir ++ "/log/") name rotateCount+        l = SL.mkSimpleLogger (dir ++ "/log/" ++ name ++ ".log")         d = CFS.mkCachedFSDatabase (dir ++ "/db") cacheSize         n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")