module ALife.Creatur.Task
(
AgentProgram,
AgentsProgram,
withAgent,
withAgents,
runNoninteractingAgents,
runInteractingAgents,
simpleJob,
startupHandler,
shutdownHandler,
doNothing,
exceptionHandler,
checkPopSize,
requestShutdown
) where
import ALife.Creatur.Daemon (Job(..))
import qualified ALife.Creatur.Daemon as D
import ALife.Creatur.Universe (Universe, Agent, AgentProgram,
AgentsProgram, writeToLog, lineup, refreshLineup, markDone, endOfRound,
withAgent, withAgents, incTime, popSize)
import Control.Conditional (whenM)
import Control.Exception (SomeException)
import Control.Monad (when)
import qualified Control.Monad.Catch as C
import Control.Monad.State (StateT, execStateT, evalStateT)
import Control.Monad.Trans.Class (lift)
import Data.Serialize (Serialize)
simpleJob :: Universe u => Job u
simpleJob = Job
{
onStartup = startupHandler,
onShutdown = shutdownHandler,
onException = exceptionHandler,
task = undefined,
sleepTime = 100
}
startupHandler :: Universe u => u -> IO u
startupHandler = execStateT (writeToLog $ "Starting")
shutdownHandler :: Universe u => u -> IO ()
shutdownHandler u = evalStateT (writeToLog "Shutdown requested") u
exceptionHandler :: Universe u => u -> SomeException -> IO u
exceptionHandler u x = execStateT (writeToLog ("WARNING: " ++ show x)) u
doNothing :: Monad m => m ()
doNothing = return ()
runNoninteractingAgents
:: (Universe u, Serialize (Agent u))
=> AgentProgram u -> StateT u IO () -> StateT u IO ()
-> StateT u IO ()
runNoninteractingAgents agentProgram startRoundProgram
endRoundProgram = do
atStartOfRound startRoundProgram
as <- lineup
when (not . null $ as) $ do
let a = head as
C.onException
(withAgent agentProgram a)
(writeToLog "Continuing after exception")
markDone a
atEndOfRound endRoundProgram
runInteractingAgents
:: (Universe u, Serialize (Agent u))
=> AgentsProgram u -> StateT u IO () -> StateT u IO ()
-> StateT u IO ()
runInteractingAgents agentsProgram startRoundProgram
endRoundProgram = do
atStartOfRound startRoundProgram
as <- lineup
C.onException
(withAgents agentsProgram as)
(writeToLog "Continuing after exception")
markDone (head as)
atEndOfRound endRoundProgram
checkPopSize :: Universe u => (Int, Int) -> StateT u IO ()
checkPopSize (minAgents, maxAgents) = do
n <- popSize
writeToLog $ "Pop. size=" ++ show n
when (n < minAgents) $ requestShutdown "population too small"
when (n > maxAgents) $ requestShutdown "population too big"
requestShutdown :: Universe u => String -> StateT u IO ()
requestShutdown s = do
writeToLog $ "Requesting shutdown: " ++ s
lift D.requestShutdown
atStartOfRound :: Universe u => StateT u IO () -> StateT u IO ()
atStartOfRound program = do
whenM endOfRound $ do
refreshLineup
incTime
writeToLog "Beginning of round"
program
atEndOfRound :: Universe u => StateT u IO () -> StateT u IO ()
atEndOfRound program = do
whenM endOfRound $ do
writeToLog "End of round"
program