Spock-worker 0.2.1.0 → 0.2.1.2
raw patch · 7 files changed
+165/−425 lines, 7 filesdep +Spock-workerdep ~HTFdep ~Spockdep ~base
Dependencies added: Spock-worker
Dependency ranges changed: HTF, Spock, base, containers, stm, text, time, vector
Files
- LICENSE +16/−199
- Spock-worker.cabal +31/−28
- src/Web/Spock/Worker.hs +1/−8
- src/Web/Spock/Worker/Internal/Queue.hs +109/−0
- src/Web/Spock/Worker/Queue.hs +0/−181
- src/Web/Spock/Worker/Tests.hs +0/−9
- test/Tests.hs +8/−0
LICENSE view
@@ -1,202 +1,19 @@-- Apache License- Version 2.0, January 2004- http://www.apache.org/licenses/-- TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION-- 1. Definitions.-- "License" shall mean the terms and conditions for use, reproduction,- and distribution as defined by Sections 1 through 9 of this document.-- "Licensor" shall mean the copyright owner or entity authorized by- the copyright owner that is granting the License.-- "Legal Entity" shall mean the union of the acting entity and all- other entities that control, are controlled by, or are under common- control with that entity. For the purposes of this definition,- "control" means (i) the power, direct or indirect, to cause the- direction or management of such entity, whether by contract or- otherwise, or (ii) ownership of fifty percent (50%) or more of the- outstanding shares, or (iii) beneficial ownership of such entity.-- "You" (or "Your") shall mean an individual or Legal Entity- exercising permissions granted by this License.-- "Source" form shall mean the preferred form for making modifications,- including but not limited to software source code, documentation- source, and configuration files.-- "Object" form shall mean any form resulting from mechanical- transformation or translation of a Source form, including but- not limited to compiled object code, generated documentation,- and conversions to other media types.-- "Work" shall mean the work of authorship, whether in Source or- Object form, made available under the License, as indicated by a- copyright notice that is included in or attached to the work- (an example is provided in the Appendix below).-- "Derivative Works" shall mean any work, whether in Source or Object- form, that is based on (or derived from) the Work and for which the- editorial revisions, annotations, elaborations, or other modifications- represent, as a whole, an original work of authorship. For the purposes- of this License, Derivative Works shall not include works that remain- separable from, or merely link (or bind by name) to the interfaces of,- the Work and Derivative Works thereof.-- "Contribution" shall mean any work of authorship, including- the original version of the Work and any modifications or additions- to that Work or Derivative Works thereof, that is intentionally- submitted to Licensor for inclusion in the Work by the copyright owner- or by an individual or Legal Entity authorized to submit on behalf of- the copyright owner. For the purposes of this definition, "submitted"- means any form of electronic, verbal, or written communication sent- to the Licensor or its representatives, including but not limited to- communication on electronic mailing lists, source code control systems,- and issue tracking systems that are managed by, or on behalf of, the- Licensor for the purpose of discussing and improving the Work, but- excluding communication that is conspicuously marked or otherwise- designated in writing by the copyright owner as "Not a Contribution."-- "Contributor" shall mean Licensor and any individual or Legal Entity- on behalf of whom a Contribution has been received by Licensor and- subsequently incorporated within the Work.-- 2. Grant of Copyright License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- copyright license to reproduce, prepare Derivative Works of,- publicly display, publicly perform, sublicense, and distribute the- Work and such Derivative Works in Source or Object form.-- 3. Grant of Patent License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- (except as stated in this section) patent license to make, have made,- use, offer to sell, sell, import, and otherwise transfer the Work,- where such license applies only to those patent claims licensable- by such Contributor that are necessarily infringed by their- Contribution(s) alone or by combination of their Contribution(s)- with the Work to which such Contribution(s) was submitted. If You- institute patent litigation against any entity (including a- cross-claim or counterclaim in a lawsuit) alleging that the Work- or a Contribution incorporated within the Work constitutes direct- or contributory patent infringement, then any patent licenses- granted to You under this License for that Work shall terminate- as of the date such litigation is filed.-- 4. Redistribution. You may reproduce and distribute copies of the- Work or Derivative Works thereof in any medium, with or without- modifications, and in Source or Object form, provided that You- meet the following conditions:-- (a) You must give any other recipients of the Work or- Derivative Works a copy of this License; and-- (b) You must cause any modified files to carry prominent notices- stating that You changed the files; and-- (c) You must retain, in the Source form of any Derivative Works- that You distribute, all copyright, patent, trademark, and- attribution notices from the Source form of the Work,- excluding those notices that do not pertain to any part of- the Derivative Works; and-- (d) If the Work includes a "NOTICE" text file as part of its- distribution, then any Derivative Works that You distribute must- include a readable copy of the attribution notices contained- within such NOTICE file, excluding those notices that do not- pertain to any part of the Derivative Works, in at least one- of the following places: within a NOTICE text file distributed- as part of the Derivative Works; within the Source form or- documentation, if provided along with the Derivative Works; or,- within a display generated by the Derivative Works, if and- wherever such third-party notices normally appear. The contents- of the NOTICE file are for informational purposes only and- do not modify the License. You may add Your own attribution- notices within Derivative Works that You distribute, alongside- or as an addendum to the NOTICE text from the Work, provided- that such additional attribution notices cannot be construed- as modifying the License.-- You may add Your own copyright statement to Your modifications and- may provide additional or different license terms and conditions- for use, reproduction, or distribution of Your modifications, or- for any such Derivative Works as a whole, provided Your use,- reproduction, and distribution of the Work otherwise complies with- the conditions stated in this License.-- 5. Submission of Contributions. Unless You explicitly state otherwise,- any Contribution intentionally submitted for inclusion in the Work- by You to the Licensor shall be under the terms and conditions of- this License, without any additional terms or conditions.- Notwithstanding the above, nothing herein shall supersede or modify- the terms of any separate license agreement you may have executed- with Licensor regarding such Contributions.-- 6. Trademarks. This License does not grant permission to use the trade- names, trademarks, service marks, or product names of the Licensor,- except as required for reasonable and customary use in describing the- origin of the Work and reproducing the content of the NOTICE file.-- 7. Disclaimer of Warranty. Unless required by applicable law or- agreed to in writing, Licensor provides the Work (and each- Contributor provides its Contributions) on an "AS IS" BASIS,- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or- implied, including, without limitation, any warranties or conditions- of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A- PARTICULAR PURPOSE. You are solely responsible for determining the- appropriateness of using or redistributing the Work and assume any- risks associated with Your exercise of permissions under this License.-- 8. Limitation of Liability. In no event and under no legal theory,- whether in tort (including negligence), contract, or otherwise,- unless required by applicable law (such as deliberate and grossly- negligent acts) or agreed to in writing, shall any Contributor be- liable to You for damages, including any direct, indirect, special,- incidental, or consequential damages of any character arising as a- result of this License or out of the use or inability to use the- Work (including but not limited to damages for loss of goodwill,- work stoppage, computer failure or malfunction, or any and all- other commercial damages or losses), even if such Contributor- has been advised of the possibility of such damages.-- 9. Accepting Warranty or Additional Liability. While redistributing- the Work or Derivative Works thereof, You may choose to offer,- and charge a fee for, acceptance of support, warranty, indemnity,- or other liability obligations and/or rights consistent with this- License. However, in accepting such obligations, You may act only- on Your own behalf and on Your sole responsibility, not on behalf- of any other Contributor, and only if You agree to indemnify,- defend, and hold each Contributor harmless for any liability- incurred by, or claims asserted against, such Contributor by reason- of your accepting any such warranty or additional liability.-- END OF TERMS AND CONDITIONS-- APPENDIX: How to apply the Apache License to your work.-- To apply the Apache License to your work, attach the following- boilerplate notice, with the fields enclosed by brackets "[]"- replaced with your own identifying information. (Don't include- the brackets!) The text should be enclosed in the appropriate- comment syntax for the file format. We also recommend that a- file or class name and description of purpose be included on the- same "printed page" as the copyright notice for easier- identification within third-party archives.-- Copyright [yyyy] [name of copyright owner]+Copyright (c) 2014 Alexander Thiemann - Licensed under the Apache License, Version 2.0 (the "License");- you may not use this file except in compliance with the License.- You may obtain a copy of the License at+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions: - http://www.apache.org/licenses/LICENSE-2.0+The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software. - Unless required by applicable law or agreed to in writing, software- distributed under the License is distributed on an "AS IS" BASIS,- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.- See the License for the specific language governing permissions and- limitations under the License.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
Spock-worker.cabal view
@@ -1,48 +1,51 @@ name: Spock-worker-version: 0.2.1.0+version: 0.2.1.2 synopsis: Background workers for Spock description: Adds a background-job queue to Spock homepage: http://github.com/agrafix/Spock-worker-license: Apache-2.0+license: MIT license-file: LICENSE-author: Alexander Thiemann <mail@agrafix.net>-maintainer: mail@agrafix.net+author: Alexander Thiemann <mail@athiemann.net>+maintainer: mail@athiemann.net copyright: (c) 2014 Alexander Thiemann category: Web build-type: Simple cabal-version: >=1.10+tested-with: GHC==7.6.3, GHC==7.8.3 library- exposed-modules: Web.Spock.Worker- other-modules: Web.Spock.Worker.Queue+ exposed-modules:+ Web.Spock.Worker,+ Web.Spock.Worker.Internal.Queue+ other-modules: hs-source-dirs: src default-language: Haskell2010- build-depends: base >=4.6 && <4.8,- Spock >=0.7.2 && <0.8,- HTF >=0.12.2.1 && <0.13,- text >=0.11.3.1 && <1.3,- time >=1.4 && <1.5,- stm >=2.4 && <2.5,- vector >=0.10 && <0.11,- containers ==0.5.*,+ build-depends:+ Spock >=0.7.2,+ base >=4.6 && < 5,+ containers >=0.5,+ lifted-base, mtl,+ stm >=2.4,+ text >=0.11.3.1,+ time >=1.4, transformers,- lifted-base+ vector >=0.10 ghc-options: -Wall -fno-warn-orphans test-suite SpockWorkerTests type: exitcode-stdio-1.0- main-is: Web/Spock/Worker/Tests.hs- hs-source-dirs: src+ main-is: Tests.hs+ hs-source-dirs: test default-language: Haskell2010- build-depends: base >=4.6 && <4.8,- Spock >=0.7.2 && <0.8,- HTF >=0.12.2.1 && <0.13,- text >=0.11.3.1 && <1.3,- time >=1.4 && <1.5,- stm >=2.4 && <2.5,- vector >=0.10 && <0.11,- containers ==0.5.*,- mtl,- transformers,- lifted-base+ build-depends:+ HTF >=0.12.2.1,+ Spock-worker,+ base >=4.6 && < 5,+ containers,+ stm,+ vector++source-repository head+ type: git+ location: git://github.com/agrafix/Spock-worker.git
src/Web/Spock/Worker.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables, OverloadedStrings #-} module Web.Spock.Worker ( -- * Worker@@ -12,24 +11,18 @@ , WorkResult (..) -- * Error Handeling , ErrorHandler(..), InternalError- -- * Tests- , htf_thisModulesTests ) where -import Test.Framework- import Control.Concurrent import Control.Concurrent.STM- import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Error import Control.Exception.Lifted as EX- import Data.Time import Web.Spock.Shared-import qualified Web.Spock.Worker.Queue as Q+import qualified Web.Spock.Worker.Internal.Queue as Q type InternalError = String
+ src/Web/Spock/Worker/Internal/Queue.hs view
@@ -0,0 +1,109 @@+module Web.Spock.Worker.Internal.Queue where++import Control.Applicative+import Control.Concurrent.STM+import Control.Monad+import Data.Maybe+import qualified Data.Map.Strict as M+import qualified Data.Vector as V++data PureQueue p v+ = PureQueue+ { pq_container :: !(M.Map p (V.Vector v))+ , pq_maxSize :: !Int+ } deriving (Show, Eq)++emptyPQ :: Int -> PureQueue p v+emptyPQ maxQueueSize =+ PureQueue M.empty maxQueueSize++sizePQ :: PureQueue p v -> Int+sizePQ (PureQueue m _) =+ M.size m++isFullPQ :: PureQueue p v -> Bool+isFullPQ pq =+ sizePQ pq >= (pq_maxSize pq)++toListPQ :: Ord p => PureQueue p v -> [(p, [v])]+toListPQ (PureQueue m _) =+ map (\(k, v) -> (k, V.toList v)) (M.toList m)++fromListPQ :: Ord p => Int -> [(p, [v])] -> Maybe (PureQueue p v)+fromListPQ limit kv+ | length kv > limit = Nothing+ | otherwise =+ Just $+ foldl (\(PureQueue content _) (k, v) ->+ (PureQueue (M.insert k (V.fromList v) content) limit)+ ) (emptyPQ limit) kv++maxPrioPQ :: Ord p => PureQueue p v -> p+maxPrioPQ (PureQueue m _) =+ fst (M.findMax m)++enqueuePQ :: Ord p => p -> v -> PureQueue p v -> (Bool, PureQueue p v)+enqueuePQ prio value pq@(PureQueue m _) =+ if isFullPQ pq+ then ( False, pq )+ else ( True+ , pq+ { pq_container =+ M.insertWith (V.++) prio (V.singleton value) m+ }+ )++dequeuePQ :: Ord p => p -> PureQueue p v -> (Maybe v, PureQueue p v)+dequeuePQ bound pq =+ removePrio $ dequeuePQ' bound pq+ where+ removePrio (Nothing, q) = (Nothing, q)+ removePrio (Just (_, v), q) = (Just v, q)++dequeuePQ' :: Ord p => p -> PureQueue p v -> (Maybe (p, v), PureQueue p v)+dequeuePQ' prioBound pq@(PureQueue m _)+ | M.null m = (Nothing, pq)+ | minK > prioBound = (Nothing, pq)+ | otherwise =+ case V.toList vec of+ [workEl] ->+ (Just (minK, workEl), updatePQ (M.delete minK))+ (workEl:xs) ->+ (Just (minK, workEl), updatePQ (M.adjust (const (V.fromList xs)) minK))+ [] ->+ error "Library-Error: This should never happen."+ where+ (minK, vec) =+ M.findMin m+ updatePQ fun =+ pq { pq_container = fun (pq_container pq) }++newtype WorkerQueue p v =+ WorkerQueue (TVar (PureQueue p v))++newQueue :: Int -> IO (WorkerQueue p v)+newQueue limit =+ WorkerQueue <$> newTVarIO (emptyPQ limit)++size :: WorkerQueue p v -> STM Int+size (WorkerQueue qVar) =+ readTVar qVar >>= (return . sizePQ)++isFull :: WorkerQueue p v -> STM Bool+isFull (WorkerQueue qVar) =+ readTVar qVar >>= (return . isFullPQ)++enqueue :: Ord p => p -> v -> WorkerQueue p v -> STM ()+enqueue prio value (WorkerQueue qVar) =+ do q <- readTVar qVar+ let (ok, newQ) = enqueuePQ prio value q+ if ok+ then writeTVar qVar newQ+ else retry++dequeue :: Ord p => p -> WorkerQueue p v -> STM (Maybe v)+dequeue minP (WorkerQueue qVar) =+ do q <- readTVar qVar+ let (mVal, newQ) = dequeuePQ minP q+ when (isJust mVal) $ writeTVar qVar newQ+ return mVal
− src/Web/Spock/Worker/Queue.hs
@@ -1,181 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Web.Spock.Worker.Queue- ( WorkerQueue, newQueue, size, enqueue, dequeue, isFull- , toListPQ, fromListPQ- , htf_thisModulesTests- )-where--import Test.Framework--import Control.Monad-import Control.Concurrent.STM-import Control.Applicative-import Data.Maybe--import qualified Data.Map.Strict as M-import qualified Data.Vector as V--data PureQueue p v- = PureQueue- { pq_container :: !(M.Map p (V.Vector v))- , pq_maxSize :: !Int- } deriving (Show, Eq)--emptyPQ :: Int -> PureQueue p v-emptyPQ maxQueueSize =- PureQueue M.empty maxQueueSize--sizePQ :: PureQueue p v -> Int-sizePQ (PureQueue m _) =- M.size m--isFullPQ :: PureQueue p v -> Bool-isFullPQ pq =- sizePQ pq >= (pq_maxSize pq)--toListPQ :: Ord p => PureQueue p v -> [(p, [v])]-toListPQ (PureQueue m _) =- map (\(k, v) -> (k, V.toList v)) (M.toList m)--fromListPQ :: Ord p => Int -> [(p, [v])] -> Maybe (PureQueue p v)-fromListPQ limit kv- | length kv > limit = Nothing- | otherwise =- Just $- foldl (\(PureQueue content _) (k, v) ->- (PureQueue (M.insert k (V.fromList v) content) limit)- ) (emptyPQ limit) kv--maxPrioPQ :: Ord p => PureQueue p v -> p-maxPrioPQ (PureQueue m _) =- fst (M.findMax m)--enqueuePQ :: Ord p => p -> v -> PureQueue p v -> (Bool, PureQueue p v)-enqueuePQ prio value pq@(PureQueue m _) =- if isFullPQ pq- then ( False, pq )- else ( True- , pq- { pq_container =- M.insertWith (V.++) prio (V.singleton value) m- }- )--dequeuePQ :: Ord p => p -> PureQueue p v -> (Maybe v, PureQueue p v)-dequeuePQ bound pq =- removePrio $ dequeuePQ' bound pq- where- removePrio (Nothing, q) = (Nothing, q)- removePrio (Just (_, v), q) = (Just v, q)--dequeuePQ' :: Ord p => p -> PureQueue p v -> (Maybe (p, v), PureQueue p v)-dequeuePQ' prioBound pq@(PureQueue m _)- | M.null m = (Nothing, pq)- | minK > prioBound = (Nothing, pq)- | otherwise =- case V.toList vec of- [workEl] ->- (Just (minK, workEl), updatePQ (M.delete minK))- (workEl:xs) ->- (Just (minK, workEl), updatePQ (M.adjust (const (V.fromList xs)) minK))- [] ->- error "Library-Error: This should never happen."- where- (minK, vec) =- M.findMin m- updatePQ fun =- pq { pq_container = fun (pq_container pq) }--newtype WorkerQueue p v =- WorkerQueue (TVar (PureQueue p v))--newQueue :: Int -> IO (WorkerQueue p v)-newQueue limit =- WorkerQueue <$> newTVarIO (emptyPQ limit)--size :: WorkerQueue p v -> STM Int-size (WorkerQueue qVar) =- readTVar qVar >>= (return . sizePQ)--isFull :: WorkerQueue p v -> STM Bool-isFull (WorkerQueue qVar) =- readTVar qVar >>= (return . isFullPQ)--enqueue :: Ord p => p -> v -> WorkerQueue p v -> STM ()-enqueue prio value (WorkerQueue qVar) =- do q <- readTVar qVar- let (ok, newQ) = enqueuePQ prio value q- if ok- then writeTVar qVar newQ- else retry--dequeue :: Ord p => p -> WorkerQueue p v -> STM (Maybe v)-dequeue minP (WorkerQueue qVar) =- do q <- readTVar qVar- let (mVal, newQ) = dequeuePQ minP q- when (isJust mVal) $ writeTVar qVar newQ- return mVal---- ---------------- TESTS--- ---------------tAddToMap :: Ord k => k -> a -> M.Map k [a] -> M.Map k [a]-tAddToMap k val m =- M.insertWith (++) k [val] m--tDeq :: Ord k => k -> PureQueue k a -> M.Map k [a]-tDeq maxP q- | sizePQ q == 0 =- M.empty- | otherwise =- let (mVal, newQ) = dequeuePQ' maxP q- in case mVal of- Nothing ->- M.empty- Just (k, val) ->- tAddToMap k val (tDeq maxP newQ)--tMappifyInput :: Ord k => [(k, a)] -> M.Map k [a]-tMappifyInput xs =- foldl (\m (k, v) ->- tAddToMap k v m- ) M.empty xs--prop_enqueueDequeuePQ :: [(Int, Int)] -> Bool-prop_enqueueDequeuePQ xs =- let pq = foldl (\q (prio :: Int, el :: Int) ->- let (ok, newPQ) = enqueuePQ prio el q- in if ok then newPQ else (error "Failed to enqueue!")- ) (emptyPQ (length xs)) xs- maxP = maxPrioPQ pq- in (tMappifyInput xs == tDeq maxP pq)--prop_onlyDequeueBelowPrio :: Int -> [(Int, Int)] -> Bool-prop_onlyDequeueBelowPrio prio xs =- let xs' = M.toList $ tMappifyInput xs- Just pq = fromListPQ (length xs) (xs' :: [(Int, [Int])])- filtered = filter (\(p, _) -> p <= prio) xs- in (tMappifyInput filtered == tDeq prio pq)--prop_isFull :: Int -> [(Int, Int)] -> Property-prop_isFull limit xs =- limit > 0 ==>- let xs' = M.toList $ tMappifyInput xs- mPq = fromListPQ limit (xs' :: [(Int, [Int])])- in case mPq of- Just pq ->- if limit == (length xs')- then isFullPQ pq- else limit > (length xs')- Nothing ->- limit < (length xs')--test_dontEnqueueIfFull :: IO ()-test_dontEnqueueIfFull =- let pq = emptyPQ 0- (ok, newPQ) = enqueuePQ (0 :: Int) False pq- in do assertBool (not ok)- assertEqual pq newPQ
− src/Web/Spock/Worker/Tests.hs
@@ -1,9 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module Main where--import Test.Framework-import {-@ HTF_TESTS @-} Web.Spock.Worker.Queue-import {-@ HTF_TESTS @-} Web.Spock.Worker--main = htfMain htf_importedTests
+ test/Tests.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import Test.Framework+import {-@ HTF_TESTS @-} Web.Spock.Worker.Internal.QueueTests++main = htfMain htf_importedTests