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 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
markDone a
withAgent agentProgram 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
markDone (head as)
withAgents agentsProgram 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