module ALife.Creatur.Universe.Task
(
AgentProgram,
AgentsProgram,
withAgent,
withAgents,
runNoninteractingAgents,
runInteractingAgents,
simpleDaemon,
startupHandler,
shutdownHandler,
exceptionHandler
) where
import ALife.Creatur (Agent, AgentId)
import ALife.Creatur.Clock (Clock, incTime)
import ALife.Creatur.Daemon (Daemon(..))
import ALife.Creatur.Database as D (Database, DBRecord, Record,
lookup)
import ALife.Creatur.Logger (Logger, writeToLog)
import ALife.Creatur.Util (rotate, shuffle)
import ALife.Creatur.Universe (Universe, agentDB, clock, multiLookup,
agentIds, storeOrArchive)
import Control.Exception (SomeException)
import Control.Lens (zoom)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Random (evalRandIO)
import Control.Monad.State (StateT, execStateT)
import Data.List (unfoldr)
import Data.Serialize (Serialize)
simpleDaemon :: Logger u => Daemon u
simpleDaemon = Daemon
{
onStartup = startupHandler,
onShutdown = shutdownHandler,
onException = exceptionHandler,
task = undefined,
username = "",
sleepTime = 100000
}
startupHandler :: Logger u => u -> IO u
startupHandler = execStateT (writeToLog "Starting")
shutdownHandler :: Logger u => u -> IO ()
shutdownHandler u = do
_ <- execStateT (writeToLog "Shutdown requested") u
return ()
exceptionHandler :: Logger u => u -> SomeException -> IO u
exceptionHandler u x = execStateT (writeToLog ("WARNING: " ++ show x)) u
type AgentProgram c l d n x a = a -> StateT (Universe c l d n x a) IO a
withAgent :: (Clock c, Logger l, Database d, Agent a, Serialize a,
Record a, a ~ DBRecord d) =>
AgentProgram c l d n x a -> AgentId ->
StateT (Universe c l d n x a) IO ()
withAgent program name =
(zoom agentDB . D.lookup) name >>= withAgent' program name
withAgent' :: (Clock c, Logger l, Database d, Agent a, Serialize a,
Record a, a ~ DBRecord d) =>
AgentProgram c l d n x a -> AgentId -> Either String a ->
StateT (Universe c l d n x a) IO ()
withAgent' _ name (Left msg) =
writeToLog $ "Unable to read '" ++ name ++ "': " ++ msg
withAgent' program _ (Right a) =
program a >>= zoom agentDB . storeOrArchive
runNoninteractingAgents :: (Clock c, Logger l, Database d, Agent a, Serialize a,
Record a, a ~ DBRecord d) =>
AgentProgram c l d n x a -> StateT (Universe c l d n x a) IO ()
runNoninteractingAgents agentProgram = do
xs <- agentIds
xs' <- liftIO $ evalRandIO $ shuffle xs
mapM_ (withAgent agentProgram) xs'
zoom clock incTime
type AgentsProgram c l d n x a =
[a] -> StateT (Universe c l d n x a) IO [a]
withAgents :: (Clock c, Logger l, Database d, Agent a, Serialize a,
Record a, a ~ DBRecord d) =>
AgentsProgram c l d n x a -> [AgentId] ->
StateT (Universe c l d n x a) IO ()
withAgents program names =
(zoom agentDB . multiLookup) names >>= withAgents' program
withAgents' :: (Clock c, Logger l, Database d, Agent a, Serialize a,
Record a, a ~ DBRecord d) =>
AgentsProgram c l d n x a -> Either String [a] ->
StateT (Universe c l d n x a) IO ()
withAgents' _ (Left msg) =
writeToLog $ "Database error: " ++ msg
withAgents' program (Right as) =
program as >>= mapM_ (zoom agentDB . storeOrArchive)
runInteractingAgents :: (Clock c, Logger l, Database d, Agent a,
Serialize a, Record a, a ~ DBRecord d) =>
AgentsProgram c l d n x a -> StateT (Universe c l d n x a) IO ()
runInteractingAgents agentsProgram = do
xs <- agentIds
xs' <- liftIO $ evalRandIO $ shuffle xs
mapM_ (withAgents agentsProgram) $ makeViews xs'
zoom clock incTime
makeViews :: [a] -> [[a]]
makeViews as = unfoldr f (0,as)
where f (n,xs) = if n == length xs then Nothing else Just (rotate xs,(n+1,rotate xs))