packages feed

creatur 5.5.1 → 5.6.0

raw patch · 9 files changed

+309/−160 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- ALife.Creatur.Checklist: data PersistentChecklist
- ALife.Creatur.Checklist: instance Eq PersistentChecklist
- ALife.Creatur.Checklist: instance Show PersistentChecklist
- ALife.Creatur.Counter: data PersistentCounter
- ALife.Creatur.Counter: instance Eq PersistentCounter
- ALife.Creatur.Counter: instance Show PersistentCounter
- ALife.Creatur.Task: noSummary :: SummaryProgram u
- ALife.Creatur.Universe: refresh :: Universe u => StateT u IO ()
+ ALife.Creatur.Checklist: notStarted :: Checklist t => StateT t IO Bool
+ ALife.Creatur.Checklist: type PersistentChecklist = Persistent Status
+ ALife.Creatur.Counter: type PersistentCounter = Persistent Int
+ ALife.Creatur.EnergyPool: available :: EnergyPool e => StateT e IO Double
+ ALife.Creatur.EnergyPool: class EnergyPool e
+ ALife.Creatur.EnergyPool: instance EnergyPool PersistentEnergyPool
+ ALife.Creatur.EnergyPool: mkPersistentEnergyPool :: FilePath -> PersistentEnergyPool
+ ALife.Creatur.EnergyPool: replenish :: EnergyPool e => Double -> StateT e IO ()
+ ALife.Creatur.EnergyPool: type PersistentEnergyPool = Persistent Double
+ ALife.Creatur.EnergyPool: withdraw :: EnergyPool e => Double -> StateT e IO Double
+ ALife.Creatur.Persistent: data Persistent a
+ ALife.Creatur.Persistent: getPS :: Read a => StateT (Persistent a) IO a
+ ALife.Creatur.Persistent: instance Eq a => Eq (Persistent a)
+ ALife.Creatur.Persistent: instance Show a => Show (Persistent a)
+ ALife.Creatur.Persistent: mkPersistent :: a -> FilePath -> Persistent a
+ ALife.Creatur.Persistent: putPS :: (Show a, Read a) => a -> StateT (Persistent a) IO ()
+ ALife.Creatur.Task: nothing :: StateT u IO ()
+ ALife.Creatur.Universe: energyPool :: Universe u => u -> EnergyPool u
+ ALife.Creatur.Universe: refreshLineup :: Universe u => StateT u IO ()
+ ALife.Creatur.Universe: replenishEnergyPool :: Universe u => Double -> StateT u IO ()
+ ALife.Creatur.Universe: setEnergyPool :: Universe u => u -> EnergyPool u -> u
+ ALife.Creatur.Universe: startOfRound :: Universe u => StateT u IO Bool
+ ALife.Creatur.Universe: withdrawEnergy :: Universe u => Double -> StateT u IO Double
- ALife.Creatur.Task: runInteractingAgents :: (Universe u, Serialize (Agent u)) => AgentsProgram u -> (Int, Int) -> SummaryProgram u -> StateT u IO Bool
+ ALife.Creatur.Task: runInteractingAgents :: (Universe u, Serialize (Agent u)) => AgentsProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO () -> StateT u IO Bool
- ALife.Creatur.Task: runNoninteractingAgents :: (Universe u, Serialize (Agent u)) => AgentProgram u -> SummaryProgram u -> StateT u IO Bool
+ ALife.Creatur.Task: runNoninteractingAgents :: (Universe u, Serialize (Agent u)) => AgentProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO () -> StateT u IO Bool
- ALife.Creatur.Universe: class (Clock (Clock u), Logger (Logger u), Database (AgentDB u), Namer (Namer u), Checklist (Checklist u), Agent (Agent u), Record (Agent u), Agent u ~ DBRecord (AgentDB u)) => Universe u where type family Agent u type family Clock u type family Logger u type family AgentDB u type family Namer u type family Checklist u
+ ALife.Creatur.Universe: class (Clock (Clock u), Logger (Logger u), Database (AgentDB u), Namer (Namer u), Checklist (Checklist u), EnergyPool (EnergyPool u), Agent (Agent u), Record (Agent u), Agent u ~ DBRecord (AgentDB u)) => Universe u where type family Agent u type family Clock u type family Logger u type family AgentDB u type family Namer u type family Checklist u type family EnergyPool u

Files

creatur.cabal view
@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.5.1+Version:           5.6.0 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.5.1+  tag:      5.6.0  library   GHC-Options:      -Wall -fno-warn-orphans@@ -51,6 +51,7 @@                     ALife.Creatur.Database.CachedFileSystem,                     ALife.Creatur.Database.CachedFileSystemInternal,                     ALife.Creatur.Database.FileSystem,+                    ALife.Creatur.EnergyPool,                     ALife.Creatur.Genetics.Analysis,                     ALife.Creatur.Genetics.BRGCBool,                     ALife.Creatur.Genetics.BRGCWord8,@@ -63,6 +64,7 @@                     ALife.Creatur.Logger.SimpleLogger,                     ALife.Creatur.Logger.SimpleRotatingLogger,                     ALife.Creatur.Namer,+                    ALife.Creatur.Persistent,                     ALife.Creatur.Universe,                     ALife.Creatur.Task,                     ALife.Creatur.Util@@ -120,6 +122,7 @@                     ALife.Creatur.Genetics.BRGCWord8QC                     ALife.Creatur.Genetics.BRGCWord16QC                     ALife.Creatur.Genetics.RecombinationQC+                    ALife.Creatur.PersistentQC  -- Benchmark creatur-bench --   Type:             exitcode-stdio-1.0
src/ALife/Creatur/Checklist.hs view
@@ -10,6 +10,7 @@ -- A simple task list which persists between runs. -- ------------------------------------------------------------------------+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module ALife.Creatur.Checklist   (     Checklist(..),@@ -17,81 +18,36 @@     mkPersistentChecklist   ) where -import ALife.Creatur.Util (modifyLift)-import Control.Monad (when, unless)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.State (StateT, get, gets, put)+import ALife.Creatur.Persistent (Persistent, mkPersistent, getPS, putPS)+import Control.Monad (when)+import Control.Monad.State (StateT) import qualified Data.List as L-import System.Directory (doesFileExist)-import System.IO (hGetContents, withFile, Handle, IOMode(ReadMode))-import Text.Read (readEither)  type Status = ([String], [String]) -- (toDo, done)  class Checklist t where   status :: StateT t IO Status   markDone :: String -> StateT t IO ()+  notStarted :: StateT t IO Bool   done :: StateT t IO Bool   setItems :: [String] -> StateT t IO ()   delete :: String -> StateT t IO () -data PersistentChecklist = PersistentChecklist {-    tInitialised :: Bool,-    tStatus :: Status,-    tFilename :: FilePath-  } deriving (Show, Eq)+type PersistentChecklist = Persistent Status  -- | Creates a counter that will store its value in the specified file. mkPersistentChecklist :: FilePath -> PersistentChecklist-mkPersistentChecklist f = PersistentChecklist False ([],[]) f+mkPersistentChecklist = mkPersistent ([],[])  instance Checklist PersistentChecklist where-  status = initIfNeeded >> gets tStatus+  status = getPS   markDone x = do-    t <- get-    let (ys,zs) = tStatus t+    (ys,zs) <- getPS     when (x `elem` ys) $ do-      let t' = t { tStatus=(L.delete x ys,zs ++ [x]) }-      put t'-      liftIO $ store t'-  done = gets (null . fst . tStatus)-  setItems ts = do-    t <- get-    let t' = t { tStatus=(ts,[]) }-    put t'-    liftIO $ store t'+      putPS (L.delete x ys, zs ++ [x])+  notStarted = fmap (null . snd) getPS+  done = fmap (null . fst) getPS+  setItems ts = putPS (ts,[])   delete tOld = do-    t <- get-    let (xs,ys) = tStatus t-    let t' = t { tStatus=(L.delete tOld xs,L.delete tOld ys) } -    put t'-    liftIO $ store t'--initIfNeeded :: StateT PersistentChecklist IO ()-initIfNeeded = do-  isInitialised <- gets tInitialised-  unless isInitialised $ modifyLift initialise--initialise :: PersistentChecklist -> IO PersistentChecklist-initialise t = do-  let f = tFilename t-  fExists <- doesFileExist f-  if fExists-    then do-      s <- withFile f ReadMode readChecklist -- closes file ASAP-      case s of-        Left msg ->-          error $ "Unable to read checklist from " ++ f ++ ": " ++ msg-        Right s'  -> return $ t { tInitialised=True, tStatus=s' }-    else return $ t { tInitialised=True }--readChecklist :: Handle -> IO (Either String Status)-readChecklist h = do-  x <- hGetContents h-  let s = readEither x-  case s of-    Left msg -> return $ Left (msg ++ "\"" ++ x ++ "\"")-    Right c  -> return $ Right c--store :: PersistentChecklist -> IO ()-store t = writeFile (tFilename t) $ show (tStatus t)+    (xs,ys) <- getPS+    putPS (L.delete tOld xs, L.delete tOld ys)
src/ALife/Creatur/Counter.hs view
@@ -10,6 +10,7 @@ -- A simple counter which persists between runs. -- ------------------------------------------------------------------------+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module ALife.Creatur.Counter   (     Counter(..),@@ -18,70 +19,25 @@   ) 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)+import ALife.Creatur.Persistent (Persistent, mkPersistent, getPS, putPS)+import Control.Monad.State (StateT)  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)+type PersistentCounter = Persistent Int  -- | Creates a counter that will store its value in the specified file. mkPersistentCounter :: FilePath -> PersistentCounter-mkPersistentCounter = PersistentCounter False (-1)+mkPersistentCounter = mkPersistent 0  instance Counter PersistentCounter where-  current = initIfNeeded >> gets cValue+  current = getPS   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 -- closes file ASAP-      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+    k <- getPS+    putPS (k+1)  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
+ src/ALife/Creatur/EnergyPool.hs view
@@ -0,0 +1,42 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.EnergyPool+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- An exhaustible resource which persists between runs.+--+------------------------------------------------------------------------+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module ALife.Creatur.EnergyPool+  (+    EnergyPool(..),+    PersistentEnergyPool,+    mkPersistentEnergyPool+  ) where++import ALife.Creatur.Persistent (Persistent, mkPersistent, getPS, putPS)+import Control.Monad.State (StateT)++class EnergyPool e where+  replenish :: Double -> StateT e IO ()+  withdraw :: Double -> StateT e IO Double+  available :: StateT e IO Double++type PersistentEnergyPool = Persistent Double++-- | Creates a resource that will store its value in the specified file.+mkPersistentEnergyPool :: FilePath -> PersistentEnergyPool+mkPersistentEnergyPool = mkPersistent 0++instance EnergyPool PersistentEnergyPool where+  replenish = putPS+  withdraw xWanted = do+    xTotal <- getPS+    let x = min xWanted xTotal+    putPS (xTotal - x)+    return x+  available = getPS
+ src/ALife/Creatur/Persistent.hs view
@@ -0,0 +1,81 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.Persistent+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A state which persists between runs.+--+------------------------------------------------------------------------+module ALife.Creatur.Persistent+  (+    Persistent,+    mkPersistent,+    getPS,+    putPS+  ) where++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)++data Persistent a = Persistent {+    psInitialised :: Bool,+    psValue :: a,+    psDefaultValue :: a,+    psFilename :: FilePath+  } deriving (Show, Eq)++-- | Creates a counter that will store its value in the specified file.+mkPersistent :: a -> FilePath -> Persistent a+mkPersistent s = Persistent False s s++getPS :: Read a => StateT (Persistent a) IO a+getPS = initIfNeeded >> gets psValue++putPS :: (Show a, Read a) => a -> StateT (Persistent a) IO ()+putPS s = do+  initIfNeeded+  modify (\p -> p { psValue=s })+  p' <- get+  liftIO $ store p'++store :: Show a => Persistent a -> IO ()+store p = do+  let f = psFilename p+  createDirectoryIfMissing True $ dropFileName f+  writeFile f $ show (psValue p)++initIfNeeded :: Read a => StateT (Persistent a) IO ()+initIfNeeded = do+  isInitialised <- gets psInitialised+  unless isInitialised $ modifyLift initialise++initialise :: Read a => Persistent a -> IO (Persistent a)+initialise p = do+  let f = psFilename p+  fExists <- doesFileExist f+  if fExists+    then do+      x <- withFile f ReadMode readValue -- closes file ASAP+      case x of+        Left msg -> error $ "Unable to read value from " ++ f ++ ": " ++ msg+        Right c  -> return $ p { psInitialised=True, psValue=c }+    else do+      return $ p { psInitialised=True, psValue=psDefaultValue p }++readValue :: Read a => Handle -> IO (Either String a)+readValue h = do+  s <- hGetContents h+  let x = readEither s+  case x of+    Left msg -> return $ Left (msg ++ "\"" ++ s ++ "\"")+    Right c  -> return $ Right c
src/ALife/Creatur/Task.hs view
@@ -28,13 +28,13 @@     startupHandler,     shutdownHandler,     exceptionHandler,-    noSummary+    nothing  ) where  import ALife.Creatur.Daemon (Daemon(..)) import ALife.Creatur.Universe (Universe, Agent, AgentProgram,-  AgentsProgram, writeToLog, lineup, refresh, markDone, endOfRound,-  withAgent, withAgents, incTime)+  AgentsProgram, writeToLog, lineup, refreshLineup, markDone, endOfRound,+  withAgent, withAgents, incTime, popSize) import Control.Conditional (whenM) import Control.Exception (SomeException) import Control.Monad.State (StateT, execStateT)@@ -66,9 +66,11 @@  runNoninteractingAgents   :: (Universe u, Serialize (Agent u))-    => AgentProgram u -> SummaryProgram u -> StateT u IO Bool-runNoninteractingAgents agentProgram summaryProgram = do-  atEndOfRound summaryProgram+    => AgentProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO ()+      -> StateT u IO Bool+runNoninteractingAgents agentProgram popRange startRoundProgram+    endRoundProgram = do+  atStartOfRound startRoundProgram   as <- lineup   if null as     then return False@@ -77,7 +79,8 @@       markDone a       -- do that first in case the next line triggers an exception       withAgent agentProgram a-      return True+      atEndOfRound endRoundProgram+      popSizeInBounds popRange  --   The input parameter is a list of agents. The first agent in the --   list is the agent whose turn it is to use the CPU. The rest of@@ -90,49 +93,48 @@  runInteractingAgents   :: (Universe u, Serialize (Agent u))-    => AgentsProgram u -> (Int, Int) -> SummaryProgram u -> StateT u IO Bool-runInteractingAgents agentsProgram (minAgents, maxAgents) summaryProgram = do-  atEndOfRound summaryProgram+    => AgentsProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO ()+      -> StateT u IO Bool+runInteractingAgents agentsProgram popRange startRoundProgram+    endRoundProgram = do+  atStartOfRound startRoundProgram   as <- lineup-  let n = length as-  writeToLog $ "Pop. size=" ++ show n+  markDone (head as)+  -- do that first in case the next line triggers an exception+  withAgents agentsProgram as+  atEndOfRound endRoundProgram+  popSizeInBounds popRange++popSizeInBounds :: Universe u => (Int, Int) -> StateT u IO Bool+popSizeInBounds (minAgents, maxAgents) = do+  n <- popSize   if n < minAgents     then do-      writeToLog "Population too small"-      summaryProgram       writeToLog "Requesting shutdown (population too small)"       return False     else       if n > maxAgents         then do-          writeToLog "Population too big"-          summaryProgram           writeToLog "Requesting shutdown (population too big)"           return False-        else do-          markDone (head as)-          -- do that first in case the next line triggers an exception-          withAgents agentsProgram as-          return True+        else return True -atEndOfRound-  :: Universe u -    => SummaryProgram u -> StateT u IO ()-atEndOfRound summaryProgram = do+atStartOfRound :: Universe u => StateT u IO () -> StateT u IO ()+atStartOfRound program = do   whenM endOfRound $ do-    writeToLog "End of round"-    summaryProgram-    refresh+    refreshLineup     incTime     writeToLog "Beginning of round"+    program --- | A program that processes the outputs from all the agent programs.---   For example, this program might aggregate the statistics and---   record the result.-type SummaryProgram u = StateT u IO ()+atEndOfRound :: Universe u => StateT u IO () -> StateT u IO ()+atEndOfRound program = do+  whenM endOfRound $ do+    writeToLog "End of round"+    program -noSummary :: SummaryProgram u-noSummary = return ()+nothing :: StateT u IO ()+nothing = return ()  -- Note: There's no reason for the checklist type to be a parameter of -- the Universe type. Users don't interact directly with it, so they
src/ALife/Creatur/Universe.hs view
@@ -43,9 +43,12 @@     isNew, -- exported for testing only     -- * Agent rotation     lineup,+    startOfRound,     endOfRound,-    refresh,-    markDone+    refreshLineup,+    markDone,+    replenishEnergyPool,+    withdrawEnergy  ) where  import Prelude hiding (lookup)@@ -60,6 +63,7 @@ import qualified ALife.Creatur.Database.CachedFileSystem as CFS import qualified ALife.Creatur.Logger as L import qualified ALife.Creatur.Logger.SimpleLogger as SL+import qualified ALife.Creatur.EnergyPool as E import ALife.Creatur.Util (stateMap, shuffle) import Control.Monad.IO.Class (liftIO) import Control.Monad.Random (evalRandIO)@@ -70,7 +74,7 @@ -- | A habitat containing artificial life. class (C.Clock (Clock u), L.Logger (Logger u), D.Database (AgentDB u),   N.Namer (Namer u), CL.Checklist (Checklist u),-  A.Agent (Agent u), D.Record (Agent u),+  E.EnergyPool (EnergyPool u), A.Agent (Agent u), D.Record (Agent u),   Agent u ~ D.DBRecord (AgentDB u))       => Universe u where   type Agent u@@ -89,6 +93,9 @@   type Checklist u   checklist :: u -> Checklist u   setChecklist :: u -> Checklist u -> u+  type EnergyPool u+  energyPool :: u -> EnergyPool u+  setEnergyPool :: u -> EnergyPool u -> u  withClock :: (Universe u, Monad m) => StateT (Clock u) m a -> StateT u m a withClock program = do@@ -123,6 +130,13 @@   u <- get   stateMap (setChecklist u) checklist program +withEnergyPool+  :: (Universe u, Monad m)+    => StateT (EnergyPool u) m a -> StateT u m a+withEnergyPool program = do+  u <- get+  stateMap (setEnergyPool u) energyPool program+ -- | The current "time" (counter) in this universe currentTime :: Universe u => StateT u IO A.Time currentTime = withClock C.currentTime@@ -243,22 +257,27 @@       program as >>= mapM_ store  -- | Returns the current lineup of (living) agents in the universe.---   Note: Check for @'endOfRound'@ and call @'refresh'@ if needed+--   Note: Check for @'endOfRound'@ and call @'refreshLineup'@ if needed --   before invoking this function. lineup :: Universe u => StateT u IO [A.AgentId] lineup = do   (xs,ys) <- withChecklist CL.status   return $ xs ++ ys +-- | Returns true if no agents have yet their turn at the CPU for this+--   round.+startOfRound :: Universe u => StateT u IO Bool+startOfRound = withChecklist CL.notStarted+ -- | Returns true if the lineup is empty or if all of the agents in the---   lineup have had their turn at the CPU.+--   lineup have had their turn at the CPU for this round. endOfRound :: Universe u => StateT u IO Bool endOfRound = withChecklist CL.done  -- | Creates a fresh lineup containing all of the agents in the --   population, in random order.-refresh :: Universe u => StateT u IO ()-refresh = do+refreshLineup :: Universe u => StateT u IO ()+refreshLineup = do   as <- shuffledAgentIds   withChecklist (CL.setItems as) @@ -271,13 +290,30 @@ shuffledAgentIds   = agentIds >>= liftIO . evalRandIO . shuffle +-- | Replenish the energy pool+replenishEnergyPool :: Universe u => Double -> StateT u IO ()+replenishEnergyPool e = do+  withEnergyPool (E.replenish e)+  y <- withEnergyPool E.available+  writeToLog $ "Replenished energy pool, " ++ show y ++ " available"++-- | Withdraw energy from the pool+withdrawEnergy :: Universe u => Double -> StateT u IO Double+withdrawEnergy e = do+  x <- withEnergyPool (E.withdraw e)+  y <- withEnergyPool E.available+  writeToLog $ "Withdrew " ++ show x ++ " from energy pool, "+    ++ show y ++ " available"+  return x+ data SimpleUniverse a = SimpleUniverse   {     suClock :: K.PersistentCounter,     suLogger :: SL.SimpleLogger,     suDB :: FS.FSDatabase a,     suNamer :: N.SimpleNamer,-    suChecklist :: CL.PersistentChecklist+    suChecklist :: CL.PersistentChecklist,+    suEnergyPool :: E.PersistentEnergyPool   } deriving (Show, Eq)  instance (A.Agent a, D.Record a) => Universe (SimpleUniverse a) where@@ -297,15 +333,19 @@   type Checklist (SimpleUniverse a) = CL.PersistentChecklist   checklist = suChecklist   setChecklist u cl = u { suChecklist=cl }+  type EnergyPool (SimpleUniverse a) = E.PersistentEnergyPool+  energyPool = suEnergyPool+  setEnergyPool u cl = u { suEnergyPool=cl }  mkSimpleUniverse :: String -> FilePath -> SimpleUniverse a mkSimpleUniverse name dir-  = SimpleUniverse c l d n cl+  = SimpleUniverse c l d n cl e   where c = K.mkPersistentCounter (dir ++ "/clock")         l = SL.mkSimpleLogger (dir ++ "/log/" ++ name ++ ".log")         d = FS.mkFSDatabase (dir ++ "/db")         n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")+        e = E.mkPersistentEnergyPool (dir ++ "/energy")  data CachedUniverse a = CachedUniverse   {@@ -313,7 +353,8 @@     cuLogger :: SL.SimpleLogger,     cuDB :: CFS.CachedFSDatabase a,     cuNamer :: N.SimpleNamer,-    cuChecklist :: CL.PersistentChecklist+    cuChecklist :: CL.PersistentChecklist,+    cuEnergyPool :: E.PersistentEnergyPool   } deriving (Show, Eq)  instance (A.Agent a, D.SizedRecord a) => Universe (CachedUniverse a) where@@ -333,12 +374,16 @@   type Checklist (CachedUniverse a) = CL.PersistentChecklist   checklist = cuChecklist   setChecklist u cl = u { cuChecklist=cl }+  type EnergyPool (CachedUniverse a) = E.PersistentEnergyPool+  energyPool = cuEnergyPool+  setEnergyPool u cl = u { cuEnergyPool=cl }  mkCachedUniverse :: String -> FilePath -> Int -> CachedUniverse a mkCachedUniverse name dir cacheSize-  = CachedUniverse c l d n cl+  = CachedUniverse c l d n cl e   where c = K.mkPersistentCounter (dir ++ "/clock")         l = SL.mkSimpleLogger (dir ++ "/log/" ++ name ++ ".log")         d = CFS.mkCachedFSDatabase (dir ++ "/db") cacheSize         n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")+        e = E.mkPersistentEnergyPool (dir ++ "/energy")
+ test/ALife/Creatur/PersistentQC.hs view
@@ -0,0 +1,61 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.PersistentQC+-- Copyright   :  (c) Amy de Buitléir 2012-2014+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE DeriveGeneric #-}++module ALife.Creatur.PersistentQC+  (+    test+  ) where++import ALife.Creatur.Persistent+import Control.Monad.State (execStateT, evalStateT, runStateT)+import System.IO.Temp (withSystemTempDirectory)+import Test.Framework as TF (Test, testGroup)+import Test.HUnit as TH (assertEqual, assertBool)+import Test.Framework.Providers.HUnit (testCase)+import System.Directory (doesFileExist, doesDirectoryExist)+import System.FilePath (dropFileName)++tryPersistent :: FilePath -> IO ()+tryPersistent dir = do+  let filename = dir ++ "/wombat/counter"+  let defaultValue = 'z'+  let k = mkPersistent defaultValue filename+  (v0, k2) <- runStateT getPS k+  assertEqual "test1" defaultValue v0+  dirExists <- doesDirectoryExist $ dropFileName filename+  assertBool "directory created too early" (not dirExists)+  fileExists <- doesFileExist filename+  assertBool "file created too early" (not fileExists)++  let v1 = 'a'+  k3 <- execStateT (putPS v1) k2+  v1a <- evalStateT getPS k3+  assertEqual "test2" v1a v1++  -- Re-read the counter. Was it updated properly?+  let k4 = mkPersistent defaultValue filename+  v1b <- evalStateT getPS k4+  assertEqual "test3" v1b v1++testPersistent :: IO ()+testPersistent = withSystemTempDirectory "creaturTest.tmp" tryPersistent++test :: TF.Test+test = testGroup "HUnit ALife.Creatur.PersistentQC"+  [+    testCase "persistent"+      testPersistent+  ]++
test/TestAll.hs view
@@ -17,18 +17,21 @@ import ALife.Creatur.UniverseQC (test) import ALife.Creatur.Database.FileSystemQC (test) import ALife.Creatur.Database.CachedFileSystemQC (test)-import ALife.Creatur.UtilQC (test) import ALife.Creatur.Genetics.DiploidQC (test) import ALife.Creatur.Genetics.RecombinationQC (test) import ALife.Creatur.Genetics.BRGCBoolQC (test) import ALife.Creatur.Genetics.BRGCWord8QC (test) import ALife.Creatur.Genetics.BRGCWord16QC (test)+import ALife.Creatur.PersistentQC (test)+import ALife.Creatur.UtilQC (test)  import Test.Framework as TF (defaultMain, Test)  tests :: [TF.Test] tests = -  [ +  [+    -- Tests are in order of increasing complexity+    ALife.Creatur.PersistentQC.test,     ALife.Creatur.CounterQC.test,     ALife.Creatur.ChecklistQC.test,     ALife.Creatur.UniverseQC.test,