creatur 5.3.2 → 5.4.0

raw patch · 3 files changed

+38/−23 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• creatur.cabal +1/−1
• src/ALife/Creatur/Daemon.hs +10/−9
• src/ALife/Creatur/Task.hs +27/−13

@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.3.2+Version:           5.4.0 Stability:         experimental Synopsis:          Framework for artificial life experiments. Description:       A software framework for automating experiments

@@ -22,7 +22,8 @@ import Control.Concurrent (MVar, newMVar, readMVar, swapMVar,    threadDelay) import Control.Exception (SomeException, handle, catch)-import Control.Monad.State (StateT, execStateT)+import Control.Monad (when)+import Control.Monad.State (StateT, runStateT) import System.IO (hPutStr, stderr) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Daemonize (CreateDaemon(..), serviced, simpleDaemon)@@ -39,9 +40,9 @@   {     onStartup :: s -> IO s,     onShutdown :: s -> IO (),-    onException :: s -> SomeException -> IO s,+    onException :: s -> SomeException -> IO (Bool, s),     -- | The agent task.-    task :: StateT s IO (),+    task :: StateT s IO Bool,     username :: String,     -- | Number of microseconds to sleep between agent tasks.     sleepTime :: Int@@ -75,13 +76,13 @@  daemonMainLoop :: Daemon s -> s -> IO () daemonMainLoop d s = do-  threadDelay $ sleepTime d-  timeToStop <- readMVar termReceived-  if timeToStop -    then onShutdown d s-    else do-      s' <- handle (onException d s) $ execStateT (task d) s+  stopRequested <- readMVar termReceived+  when (not stopRequested) $ do+    (continue, s') <- handle (onException d s) $ runStateT (task d) s+    when continue $ do+      threadDelay $ sleepTime d       daemonMainLoop d s'+  onShutdown d s  wrap :: IO () -> IO () wrap t = catch t

@@ -37,7 +37,6 @@   withAgent, withAgents, incTime) import Control.Conditional (whenM) import Control.Exception (SomeException)-import Control.Monad (when) import Control.Monad.State (StateT, execStateT) import Data.Serialize (Serialize) @@ -60,18 +59,25 @@   _ <- execStateT (writeToLog "Shutdown requested") u   return () -exceptionHandler :: Universe u => u -> SomeException -> IO u-exceptionHandler u x = execStateT (writeToLog ("WARNING: " ++ show x)) u+exceptionHandler :: Universe u => u -> SomeException -> IO (Bool, u)+exceptionHandler u x = do+  u' <- execStateT (writeToLog ("WARNING: " ++ show x)) u+  return (True, u')  runNoninteractingAgents   :: (Universe u, Serialize (Agent u))-    => AgentProgram u -> SummaryProgram u -> StateT u IO ()+    => AgentProgram u -> SummaryProgram u -> StateT u IO Bool runNoninteractingAgents agentProgram summaryProgram = do   atEndOfRound summaryProgram-  (a:_) <- lineup-  markDone a-    -- do that first in case the next line triggers an exception-  withAgent agentProgram a+  as <- lineup+  if null as+    then return False+    else do+      let a = head as+      markDone a+      -- do that first in case the next line triggers an exception+      withAgent agentProgram a+      return True  --   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@@ -84,13 +90,21 @@  runInteractingAgents   :: (Universe u, Serialize (Agent u))-    => AgentsProgram u -> SummaryProgram u -> StateT u IO ()-runInteractingAgents agentsProgram summaryProgram = do+    => AgentsProgram u -> Int -> SummaryProgram u -> StateT u IO Bool+runInteractingAgents agentsProgram minAgents summaryProgram = do   atEndOfRound summaryProgram   as <- lineup-  when (not $ null as) $ markDone (head as)-    -- do that first in case the next line triggers an exception-  withAgents agentsProgram as+  if length (take minAgents as) < minAgents -- efficient way of checking length, I think+    then do+      writeToLog "Population too small"+      summaryProgram+      writeToLog "Requesting shutdown (population too small)"+      return False+    else do+      markDone (head as)+      -- do that first in case the next line triggers an exception+      withAgents agentsProgram as+      return True  atEndOfRound   :: Universe u