yam-job 0.1.10 → 0.1.11

raw patch · 2 files changed

+22/−34 lines, 2 files

Files

• src/Yam/Job.hs +21/−33
• yam-job.cabal +1/−1

@@ -5,8 +5,7 @@  module Yam.Job(     YamJob(..)-  , MonadJob(..)-  , startJob+  , withJobs   ) where  import           Yam.App@@ -19,34 +18,23 @@   , func :: AppM IO ()   } -class MonadIO m => MonadJob m where-  yamJobs :: m [(ThreadId, YamJob)]-  registerJob :: YamJob -> m ()-  killJobs :: m ()--keyJob :: Text-keyJob = "Extension.Job"--instance (MonadIO m, MonadMask m) => MonadJob (AppM m) where-  yamJobs = getExtensionOrDefault [] keyJob-  killJobs = yamJobs >>= mapM_ go >> setExtension keyJob ([] :: [(ThreadId, YamJob)])-    where go (tid,job) = do infoLn $ "Stop job " <> name (job :: YamJob) <> "..."-                            liftIO $ killThread tid-  registerJob job = do-    let nm = name (job :: YamJob)-    infoLn $ "Register job " <> nm <> " with cron '" <> cron job <> "'"-    context  <- ask-    [thread] <- liftIO $ execSchedule-                      $ flip addJob (cron job)-                      $ do reqId <- randomHex 8-                           runAppM context $ withLoggerName (reqId <> " job." <> nm)-                                           $ do infoLn $ "Start job " <> nm-                                                func job-                                                infoLn ("End job " <> nm)-    jobs <- yamJobs-    setExtension keyJob ((thread,job):jobs)--startJob :: [YamJob] -> (YamContext -> IO YamContext) -> IO ()-startJob jobs initialize = do-  context <- defaultContext >>= initialize-  runAppM context $ mapM_ registerJob jobs+withJobs :: (MonadIO m, MonadMask m) => [YamJob] -> AppM m a -> AppM m a+withJobs jobs action = do+    context <- ask+    threads <- liftIO $ execSchedule+                      $ mapM_ (go context) jobs+    let tjobs = zipWith (,) threads jobs+    mapM_ (prt True) tjobs+    action `finally` kill tjobs+    where go context job = flip addJob (cron job) $ do+            reqId <- randomHex 8+            let nm = name (job :: YamJob)+            runAppM context $ withLoggerName (reqId <> " job." <> nm)+                            $ do infoLn $ "Start job " <> nm+                                 func job+                                 infoLn ("End job " <> nm)+          kill ts = mapM_ (prt False) ts >> (liftIO $ mapM_ (killThread.fst) ts)+          prt v (_,job) = do+            let nm = name (job :: YamJob)+                r  = if v then "Register" else "Unregister"+            infoLn $ r <> " job " <> nm <> " with cron '" <> cron job <> "'"

@@ -1,5 +1,5 @@ name:                yam-job-version:             0.1.10+version:             0.1.11 description:         Job Module for Yam homepage:            https://github.com/leptonyu/yam/tree/master/yam-job#readme license:             BSD3