creatur 5.7.0 → 5.7.1

raw patch · 3 files changed

+41/−37 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• creatur.cabal +2/−2
• src/ALife/Creatur/Daemon.hs +32/−28
• src/ALife/Creatur/Task.hs +7/−7

@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.7.0+Version:           5.7.1 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.7.0+  tag:      5.7.1  library   GHC-Options:      -Wall -fno-warn-orphans

@@ -15,8 +15,9 @@  module ALife.Creatur.Daemon   (-    TaskConfig(..),-    Daemon(..),+    Job(..),+    CreaturDaemon(..),+    simpleDaemon,     launch,     requestShutdown   ) where@@ -28,7 +29,7 @@ import Control.Monad.State (StateT, execStateT) import System.IO (hPutStr, stderr) import System.IO.Unsafe (unsafePerformIO)-import System.Posix.Daemonize (CreateDaemon(..), serviced, simpleDaemon)+import qualified System.Posix.Daemonize as D import System.Posix.Signals (Handler(Catch), fullSignalSet,    installHandler, sigTERM) import System.Posix.User (getLoginName, getRealUserID)@@ -36,8 +37,8 @@ termReceived :: MVar Bool termReceived = unsafePerformIO (newMVar False) --- | Task configuration.-data TaskConfig s = TaskConfig+-- | The work to be performed by a daemon.+data Job s = Job   {     -- | Operations to perform on startup.     onStartup :: s -> IO s,@@ -46,54 +47,57 @@     -- | Operations to perform if an exception occurs.     onException :: s -> SomeException -> IO s,     -- | Operations to perform repeatedly while running.-    run :: StateT s IO (),-    -- | Number of microseconds to sleep between invocations of @'run'@.+    task :: StateT s IO (),+    -- | Number of microseconds to sleep between invocations of @'task'@.     sleepTime :: Int   } -data Daemon p s = Daemon+data CreaturDaemon p s = CreaturDaemon   {-    daemon :: CreateDaemon p,-    task :: TaskConfig s+    daemon :: D.CreateDaemon p,+    job :: Job s   } --- | @'launch' daemon state@ creates a daemon, which invokes @task@.+-- | Creates a simple daemon to run a job. The daemon will run under+--   the login name.+simpleDaemon :: Job s -> s -> D.CreateDaemon ()+simpleDaemon j s = D.simpleDaemon { D.program = daemonMain j s,+                                    D.user    = Just "" }++-- | @'launch' daemon state@ creates a daemon, which invokes @daemon@. --   *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+launch :: CreaturDaemon p s -> IO ()+launch d = do   uid <- getRealUserID   if uid /= 0     then putStrLn "Must run as root"     else do-      u <- defaultToLoginName (user . daemon $ d)-      serviced $ simpleDaemon -        { program = daemonMain d s,-          user    = u }+      u <- defaultToLoginName (D.user . daemon $ d)+      D.serviced $ (daemon d) { D.user = u }  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' <- handle ((onException . task $ d) s) ((onStartup . task $ d) s)+daemonMain :: Job s -> s -> () -> IO ()+daemonMain t s _ = do+  s' <- handle (onException t s) (onStartup t s)   _ <- installHandler sigTERM (Catch requestShutdown)         (Just fullSignalSet)-  _ <- wrap (daemonMainLoop d s')+  _ <- wrap (daemonMainLoop t s')   return () -daemonMainLoop :: Daemon p s -> s -> IO ()-daemonMainLoop d s = do-  let st = sleepTime . task $ d+daemonMainLoop :: Job s -> s -> IO ()+daemonMainLoop t s = do+  let st = sleepTime t   stopRequested <- readMVar termReceived   when (not stopRequested) $ do-    s' <- handle ((onException . task $ d) s) $-           execStateT (run . task $ d) s+    s' <- handle (onException t s) $ execStateT (task t) s     when (st > 0) $ threadDelay st-    daemonMainLoop d s'-  (onShutdown . task $ d) s+    daemonMainLoop t s'+  onShutdown t s  wrap :: IO () -> IO () wrap t = catch t

@@ -24,14 +24,14 @@     withAgents,     runNoninteractingAgents,     runInteractingAgents,-    simpleTaskConfig,+    simpleJob,     startupHandler,     shutdownHandler,-    exceptionHandler-    -- requestShutdown+    exceptionHandler,+    requestShutdown  ) where -import ALife.Creatur.Daemon (TaskConfig(..))+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,@@ -43,13 +43,13 @@ import Control.Monad.Trans.Class (lift) import Data.Serialize (Serialize) -simpleTaskConfig :: Universe u => TaskConfig u-simpleTaskConfig = TaskConfig+simpleJob :: Universe u => Job u+simpleJob = Job   {     onStartup = startupHandler,     onShutdown = shutdownHandler,     onException = exceptionHandler,-    run = undefined,+    task = undefined,     sleepTime = 100   }