module ALife.Creatur.Task
(
AgentProgram,
AgentsProgram,
withAgent,
withAgents,
runNoninteractingAgents,
runInteractingAgents,
simpleDaemon,
startupHandler,
shutdownHandler,
exceptionHandler,
nothing
) where
import ALife.Creatur.Daemon (Daemon(..))
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)
simpleDaemon :: Universe u => Daemon u
simpleDaemon = Daemon
{
onStartup = startupHandler,
onShutdown = shutdownHandler,
onException = exceptionHandler,
task = undefined,
username = "",
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
runNoninteractingAgents
:: (Universe u, Serialize (Agent u))
=> AgentProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO ()
-> StateT u IO ()
runNoninteractingAgents agentProgram popRange startRoundProgram
endRoundProgram = do
atStartOfRound startRoundProgram
as <- lineup
when (not . null $ as) $ do
let a = head as
markDone a
withAgent agentProgram a
atEndOfRound endRoundProgram
checkPopSize popRange
runInteractingAgents
:: (Universe u, Serialize (Agent u))
=> AgentsProgram u -> (Int, Int) -> StateT u IO () -> StateT u IO ()
-> StateT u IO ()
runInteractingAgents agentsProgram popRange startRoundProgram
endRoundProgram = do
atStartOfRound startRoundProgram
as <- lineup
markDone (head as)
withAgents agentsProgram as
atEndOfRound endRoundProgram
checkPopSize popRange
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
nothing :: StateT u IO ()
nothing = return ()