jobqueue 0.1.3 → 0.1.4

raw patch · 3 files changed

+67/−2 lines, 3 filesdep +regex-posix

Dependencies added: regex-posix

Files

• jobqueue.cabal +5/−1
• src/Network/JobQueue/Logger.hs +15/−1
• src/Network/JobQueue/Util.hs +47/−0

@@ -1,14 +1,16 @@ Name:           jobqueue-Version:        0.1.3+Version:        0.1.4 Synopsis:       A job queue library License:        MIT License-File:   LICENSE Author:         Kiyoshi Ikehara Maintainer:     kiyoshi.ikehara at gree.net+Stability:      experimental Copyright:      GREE, Inc. Build-Type:     Simple Category:       Network, Client Cabal-Version:  >=1.8+Homepage:       https://github.com/gree/haskell-jobqueue Description:   Haskell JobQueue is a library used for building a job scheduler with priority queues.   The state of jobs is stored in a backend database such as Apache Zookeeper or other @@ -43,6 +45,7 @@                  , monad-control                  , transformers-base                  , lifted-base+                 , regex-posix   Hs-source-dirs:  src   Exposed-modules: Network.JobQueue                  , Network.JobQueue.Class@@ -59,6 +62,7 @@                  , Network.JobQueue.Backend.Zookeeper                  , Network.JobQueue.Backend.Sqlite3                  , Network.JobQueue.Logger+                 , Network.JobQueue.Util   Other-modules:   Network.JobQueue.Backend.Zookeeper.ZookeeperQueue   Extensions:      DeriveDataTypeable 

@@ -17,9 +17,23 @@ import qualified Control.Monad.Logger as ML import Language.Haskell.TH.Syntax (Q, Exp, qLocation) import Data.Text.Format+import Control.Applicative+import Control.Monad.Reader +import Network.JobQueue.Types+import Network.JobQueue.Class+ logTH :: ML.LogLevel -> Q Exp-logTH level = [|\a b -> ML.monadLoggerLog $(qLocation >>= ML.liftLoc) (T.pack "") level (LT.toStrict $ format (a :: Format) b)|]+logTH level = +  [|\a b -> do+    ju <- getJobUnit <$> ask+    ML.monadLoggerLog $(qLocation >>= ML.liftLoc) (T.pack "") level $ T.concat+      [ (LT.toStrict $ format (a :: Format) b)+      , " ("+      , T.pack $ desc ju+      , ")"+      ]+  |]  logDebug :: Q Exp logDebug = logTH ML.LevelDebug

@@ -0,0 +1,47 @@+-- Copyright (c) Gree, Inc. 2013+-- License: MIT-style++module Network.JobQueue.Util+  ( waitForAllJobs+  , waitUntilMatch+  ) where++import Data.Maybe+import Control.Concurrent+import Network.JobQueue.Types+import Network.JobQueue.Class+import Network.JobQueue.Job+import Network.JobQueue.JobQueue+import Network.JobQueue.JobQueue.Internal+import Text.Regex.Posix++waitForAllJobs :: (Env e, Unit a) => JobQueue e a -> Int -> ((Maybe (Job a)) -> Int -> IO ()) -> IO (Maybe (Job a))+waitForAllJobs jq timeoutCount = waitWhile jq (\mjob count -> isJust mjob && count < timeoutCount)++waitUntilMatch :: (Env e, Unit a) => JobQueue e a -> String -> Int -> ((Maybe (Job a)) -> Int -> IO ()) -> IO (Maybe (Job a))+waitUntilMatch jq pattern timeoutCount = waitWhile jq (\mjob count -> not (show mjob =~ pattern) && count < timeoutCount)++waitWhile :: (Env e, Unit a)+             => JobQueue e a+             -> (Maybe (Job a) -> Int -> Bool)+             -> (Maybe (Job a) -> Int -> IO ())+             -> IO (Maybe (Job a))+waitWhile jq cond reportAct = loop 0+  where+    loop count = do+      mjob <- liftIO $ peekJob jq+      reportAct mjob count+      if cond mjob count+        then do+          mjob' <- innerloop jq mjob cond+          if mjob' == mjob then return mjob else loop (count + 1)+        else do+          return mjob+    +    innerloop :: (Env e, Unit a) => JobQueue e a -> Maybe (Job a) -> (Maybe (Job a) -> Int -> Bool) -> IO (Maybe (Job a))+    innerloop jq mjob0 cond = loop 0+      where+        loop tickCount = do+          threadDelay 250000+          mjob <- liftIO $ peekJob jq+          if mjob0 == mjob && cond mjob tickCount then loop (tickCount + 1) else return mjob