Spock-worker 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+55/−2 lines, 2 files

Files

• Spock-worker.cabal +2/−2
• src/Web/Spock/Worker/Queue.hs +53/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                Spock-worker-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Background workers for Spock description:         Adds a background-job queue to Spock homepage:            http://github.com/agrafix/Spock-worker@@ -17,7 +17,7 @@  library   exposed-modules:     Web.Spock.Worker-  -- other-modules:       +  other-modules:       Web.Spock.Worker.Queue   build-depends:       base >=4.6 && <4.7,                        Spock >=0.4.2.1 && <0.4.3,                        text >=0.11.3.1 && <1.2,

@@ -0,0 +1,53 @@+module Web.Spock.Worker.Queue+    ( WorkerQueue, newQueue, size, enqueue, dequeue, isFull )+where++import Control.Concurrent.STM+import Control.Applicative+import qualified Data.Map.Strict as M+import qualified Data.Vector as V++data WorkerQueue p v+   = WorkerQueue+   { wq_container :: TVar (M.Map p (V.Vector v))+   , wq_maxSize :: Int+   }++newQueue :: Int -> IO (WorkerQueue p v)+newQueue limit =+    (flip WorkerQueue) limit <$> newTVarIO M.empty++size :: WorkerQueue p v -> STM Int+size (WorkerQueue q _) =+    M.size <$> readTVar q++isFull :: WorkerQueue p v -> STM Bool+isFull wq@(WorkerQueue _ sizeLimit) =+    do currSize <- size wq+       return (currSize >= sizeLimit)++enqueue :: Ord p => p -> v -> WorkerQueue p v -> STM ()+enqueue priority value wq@(WorkerQueue q _) =+    do full <- isFull wq+       if full+       then retry+       else modifyTVar' q (M.insertWith (V.++) priority (V.singleton value))++dequeue :: Ord p => WorkerQueue p v -> STM v+dequeue (WorkerQueue q _) =+    do m <- readTVar q+       if M.null m+       then retry+       else runDequeue m+    where+      runDequeue m =+          do let (minPrio, vals) = M.findMin m+             case V.toList vals of+               [workEl] ->+                   do writeTVar q (M.delete minPrio m)+                      return workEl+               (workEl:xs) ->+                   do writeTVar q (M.adjust (const (V.fromList xs)) minPrio m)+                      return workEl+               [] ->+                   error "Library-Error: This should never happen."