haskell-disque (empty) → 0.0.1.0

raw patch · 7 files changed

+270/−0 lines, 7 filesdep +basedep +bytestringdep +haskell-disquesetup-changed

Dependencies added: base, bytestring, haskell-disque, hedis, string-conversions

Files

LICENSE +30/−0
README.md +8/−0
Setup.hs +2/−0
app/Main.hs +4/−0
haskell-disque.cabal +60/−0
src/Database/Disque.hs +164/−0
test/Spec.hs +2/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,8 @@+# haskell-disque a client for Disque++Disque is a distributed, in memory, message broker.++NOTE: this is a early state , most of the functionality in this package are not tested and not production ready+++

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn ""

+ haskell-disque.cabal view

@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name:                haskell-disque+version:             0.0.1.0+synopsis:            Client library for the Disque datastore+description:         Disque is an ongoing experiment to build a distributed, in-memory, message broker.Its goal is to capture the essence of the "Redis as a jobs queue" use case, which is usually implemented using blocking list operations, and move it into an ad-hoc, self-contained, scalable, and fault tolerant design, with simple to understand properties and guarantees, but still resembling Redis in terms of simplicity, performance, and implementation as a C non-blocking networked server. This library is a Haskell client for the Disque datastore.+homepage:            https://github.com/ArekCzarnik/haskell-disque#readme+bug-reports:         https://github.com/ArekCzarnik/haskell-disque/issues+license:             BSD3+license-file:        LICENSE+author:              Arek Czarnik+maintainer:          arekczarnik@gmail.com+copyright:           2017 Arek Czarnik+category:            Database+build-type:          Simple+cabal-version:       >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/ArekCzarnik/haskell-disque++library+  hs-source-dirs:+      src+  exposed-modules:+      Database.Disque+  other-modules:+      Paths_haskell_disque+  build-depends:+      base >=4.7 && <5+    , hedis+    , string-conversions+    , bytestring+  default-language: Haskell2010++executable haskell-disque-exe+  hs-source-dirs:+      app+  main-is: Main.hs+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base+    , haskell-disque+  default-language: Haskell2010++test-suite haskell-disque-test+  type: exitcode-stdio-1.0+  hs-source-dirs:+      test+  main-is: Spec.hs+  build-depends:+      base+    , haskell-disque+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-language: Haskell2010

+ src/Database/Disque.hs view

@@ -0,0 +1,164 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE CPP                        #-}++module Database.Disque+    (+      Disque+    , runDisque++    , Connection+    , ConnectInfo(..)+    , Reply(..)++    , Job(..)+    , JobId++      -- Create and run disque+    , disqueConnectInfo+    , connect++      -- * Main API+    , addjob+    , getjob+    , getjobs+    , ackjob+    , fastack+    , working+    , nack++      -- * Other Commands+    , info'+    , hello+    , qlen+    , qstat+    , qpeek+    , enqueue+    , dequeue+    , deljob+    , jshow+    , qscan+    , jscan++      -- * High level functions+    , withGetJobs+    ) where++import qualified Data.ByteString.Char8 as BS8++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+import Control.Applicative+#endif++import Control.Monad.IO.Class+import Data.ByteString        (ByteString)+import Database.Redis as R+import Data.String.Conversions (cs)+++newtype Disque a+  = Disque (Redis a)+    deriving ( Functor+             , Applicative+             , Monad+             , MonadIO+             , MonadRedis+             )++-- | Run disque transformer+runDisque :: Connection -> Disque a -> IO a+runDisque c (Disque m) = runRedis c m++-- | Disque job+--+-- Job IDs start with a DI and end with an SQ and are always 48 characters+type JobId = ByteString+type Queue = ByteString+type Data  = ByteString++data Job = Job {queue:: Queue, jobid :: JobId, jobdata :: Data}+           deriving (Show)++instance RedisResult Job where+    decode (MultiBulk (Just (x:y:z:_))) =+      Job <$> decode x <*> decode y <*> decode z+    decode r = Left r++-- | Disque connection information+--+-- Use this smart constructor to override specifics+-- to your client connection+--+-- e.g.+--+-- > disqueConnectInfo { connectPort = PortNumber 7712 }+--+disqueConnectInfo :: ConnectInfo+disqueConnectInfo+  = defaultConnectInfo {+      connectHost = "127.0.0.1"+    , connectPort = PortNumber 7711+    }++bshow :: Show a => a -> BS8.ByteString+bshow = BS8.pack . show++addjob :: ByteString -> ByteString -> Int -> Disque (Either Reply ByteString)+addjob q jobdata_ _timeout = Disque $ sendRequest ["ADDJOB", q, jobdata_, cs $ show _timeout]++getjob :: [ByteString] ->  Disque (Either Reply Job)+getjob qs = Disque $ sendRequest $ ["GETJOB", "FROM"] ++ qs++getjobs :: [ByteString] -> Int -> Disque (Either Reply [Job])+getjobs qs cnt = Disque $ sendRequest $ ["GETJOB", "COUNT", bshow cnt, "FROM"] ++ qs++ackjob :: [ByteString] -> Disque (Either Reply ByteString)+ackjob js = Disque $ sendRequest $ "ACKJOB" : js++fastack :: [ByteString] -> Disque (Either Reply ByteString)+fastack js = Disque $ sendRequest $ "FASTACK" : js++working :: ByteString -> Disque (Either Reply ByteString)+working jid = Disque $ sendRequest ["WORKING", jid]++nack :: [ByteString] -> Disque (Either Reply ByteString)+nack js = Disque $ sendRequest $ "NACK" : js++info' :: Disque (Either Reply ByteString)+info' = Disque $ sendRequest ["INFO"]++hello :: Disque (Either Reply ByteString)+hello = Disque $ sendRequest ["HELLO"]++qlen :: ByteString -> Disque (Either Reply ByteString)+qlen qname = Disque $ sendRequest ["QLEN", qname]++qstat :: ByteString -> Disque (Either Reply ByteString)+qstat qname = Disque $ sendRequest ["QSTAT", qname]++qpeek :: ByteString -> ByteString -> Disque (Either Reply ByteString)+qpeek qname cnt = Disque $ sendRequest ["QPEEK", qname, cnt]++enqueue :: [ByteString] -> Disque (Either Reply ByteString)+enqueue jids = Disque $ sendRequest $ "ENQUEUE" : jids++dequeue :: [ByteString] -> Disque (Either Reply ByteString)+dequeue jids = Disque $ sendRequest $ "DEQUEUE" : jids++deljob :: [ByteString] -> Disque (Either Reply ByteString)+deljob jids = Disque $ sendRequest $ "ENQUEUE" : jids++jshow :: ByteString -> Disque (Either Reply ByteString)+jshow jid = Disque $ sendRequest ["SHOW", jid]++qscan :: ByteString -> Disque (Either Reply ByteString)+qscan _ = Disque $ sendRequest ["QSCAN"]++jscan :: ByteString -> Disque (Either Reply ByteString)+jscan _ = Disque $ sendRequest ["JSCAN"]++withGetJobs :: [ByteString] -> Int -> (Job -> Disque a) -> Disque [a]+withGetJobs qs jids f = do+  Right jobs <- getjobs qs jids+  mapM f jobs

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"