creatur 5.6.9 → 5.7.0

raw patch · 3 files changed

+45/−36 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• creatur.cabal +2/−2
• src/ALife/Creatur/Daemon.hs +36/−25
• src/ALife/Creatur/Task.hs +7/−9

@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.6.9+Version:           5.7.0 Stability:         experimental Synopsis:          Framework for artificial life experiments. Description:       A software framework for automating experiments@@ -36,7 +36,7 @@ source-repository this   type:     git   location: https://github.com/mhwombat/creatur.git-  tag:      5.6.9+  tag:      5.7.0  library   GHC-Options:      -Wall -fno-warn-orphans

@@ -15,6 +15,7 @@  module ALife.Creatur.Daemon   (+    TaskConfig(..),     Daemon(..),     launch,     requestShutdown@@ -35,54 +36,64 @@ termReceived :: MVar Bool termReceived = unsafePerformIO (newMVar False) --- | Daemon configuration.---   If @username@ is null, the daemon will run under the login name.-data Daemon s = Daemon+-- | Task configuration.+data TaskConfig s = TaskConfig   {+    -- | Operations to perform on startup.     onStartup :: s -> IO s,+    -- | Operations to perform on shutdown.     onShutdown :: s -> IO (),+    -- | Operations to perform if an exception occurs.     onException :: s -> SomeException -> IO s,-    -- | The agent task.-    task :: StateT s IO (),-    username :: String,-    -- | Number of microseconds to sleep between agent tasks.+    -- | Operations to perform repeatedly while running.+    run :: StateT s IO (),+    -- | Number of microseconds to sleep between invocations of @'run'@.     sleepTime :: Int   } --- | @'launch' daemon state@ creates a daemon running under the current---   user's real userID, which invokes @task@.-launch :: Daemon s -> s -> IO ()+data Daemon p s = Daemon+  {+    daemon :: CreateDaemon p,+    task :: TaskConfig s+  }++-- | @'launch' daemon state@ creates a daemon, which invokes @task@.+--   *Note:* If @'user'@ (in @'daemon'@) is @Just ""@, the daemon will+--   run under the login name. If @'user'@ is Nothing, the daemon will+--   run under the name of the executable file containing the daemon. +launch :: Daemon p s -> s -> IO () launch d s = do   uid <- getRealUserID   if uid /= 0     then putStrLn "Must run as root"     else do-      u <- daemonUsername d+      u <- defaultToLoginName (user . daemon $ d)       serviced $ simpleDaemon          { program = daemonMain d s,-          user    = Just u }+          user    = u } -daemonUsername :: Daemon s -> IO String-daemonUsername d =-  if (null . username) d-    then getLoginName-    else (return . username) d-    -daemonMain :: Daemon s -> s -> () -> IO ()+defaultToLoginName :: Maybe String -> IO (Maybe String)+defaultToLoginName (Just "") = fmap Just getLoginName+defaultToLoginName x = return x++daemonMain :: Daemon p s -> s -> () -> IO () daemonMain d s _ = do-  s' <- onStartup d s-  _ <- installHandler sigTERM (Catch requestShutdown) (Just fullSignalSet)+  s' <- handle ((onException . task $ d) s) ((onStartup . task $ d) s)+  _ <- installHandler sigTERM (Catch requestShutdown)+        (Just fullSignalSet)   _ <- wrap (daemonMainLoop d s')   return () -daemonMainLoop :: Daemon s -> s -> IO ()+daemonMainLoop :: Daemon p s -> s -> IO () daemonMainLoop d s = do+  let st = sleepTime . task $ d   stopRequested <- readMVar termReceived   when (not stopRequested) $ do-    s' <- handle (onException d s) $ execStateT (task d) s-    when (sleepTime d > 0) $ threadDelay $ sleepTime d+    s' <- handle ((onException . task $ d) s) $+           execStateT (run . task $ d) s+    when (st > 0) $ threadDelay st     daemonMainLoop d s'-  onShutdown d s+  (onShutdown . task $ d) s  wrap :: IO () -> IO () wrap t = catch t

@@ -24,15 +24,14 @@     withAgents,     runNoninteractingAgents,     runInteractingAgents,-    simpleDaemon,+    simpleTaskConfig,     startupHandler,     shutdownHandler,-    exceptionHandler,-    -- nothing,-    requestShutdown+    exceptionHandler+    -- requestShutdown  ) where -import ALife.Creatur.Daemon (Daemon(..))+import ALife.Creatur.Daemon (TaskConfig(..)) import qualified ALife.Creatur.Daemon as D import ALife.Creatur.Universe (Universe, Agent, AgentProgram,   AgentsProgram, writeToLog, lineup, refreshLineup, markDone, endOfRound,@@ -44,14 +43,13 @@ import Control.Monad.Trans.Class (lift) import Data.Serialize (Serialize) -simpleDaemon :: Universe u => Daemon u-simpleDaemon = Daemon+simpleTaskConfig :: Universe u => TaskConfig u+simpleTaskConfig = TaskConfig   {     onStartup = startupHandler,     onShutdown = shutdownHandler,     onException = exceptionHandler,-    task = undefined,-    username = "",+    run = undefined,     sleepTime = 100   }