packages feed

hedis-pile (empty) → 0.1.0

raw patch · 6 files changed

+251/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, hedis, hedis-pile, hedis-tags, lifted-base, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers

Files

+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2011, John Lenz. 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ hedis-pile.cabal view
@@ -0,0 +1,53 @@+name:           hedis-pile
+version:        0.1.0
+cabal-version:  >= 1.8
+build-type:     Simple
+stability:      Experimental
+license:        BSD3
+license-file:   LICENSE
+synopsis:       Caching mandatory data with Redis
+description:    Solution for caching mandatory data with Redis.
+category:       Database
+author:         Alexander Dorofeev <aka.spin@gmail.com>
+maintainer:     Alexander Dorofeev <aka.spin@gmail.com>
+homepage:       https://github.com/akaspin/hedis-pile
+
+source-repository head
+  type:         git
+  location:     git://github.com/akaspin/hedis-pile.git
+
+library
+  hs-source-dirs:  src
+  build-depends:   
+                   base >= 4 && < 5,
+                   bytestring >= 0.9 && < 0.10,
+                   hedis >= 0.3 && < 0.4,
+                   hedis-tags >= 0.1,
+                   transformers >= 0.2 && < 0.3
+  ghc-options:     -Wall
+  exposed-modules: Database.Redis.Pile
+
+test-suite test
+  type:            exitcode-stdio-1.0
+  x-uses-tf:       true
+  hs-source-dirs: test
+  build-depends:   
+                   base >= 4,
+                   HUnit >= 1.2 && < 2,
+                   QuickCheck >= 2.4,
+                   test-framework >= 0.4.1,
+                   test-framework-quickcheck2,
+                   test-framework-hunit,
+                  
+                   hedis-pile,
+                   
+                   -- from lib
+                   bytestring >= 0.9 && < 0.10,
+                   hedis >= 0.3 && < 0.4,
+ 
+                   lifted-base,
+                   transformers >= 0.2 && < 0.3
+  ghc-options:     -Wall -rtsopts -threaded
+  main-is:         Main.hs
+  other-modules:   Database.Redis.Test.Pile
+
+ src/Database/Redis/Pile.hs view
@@ -0,0 +1,89 @@+-- | Solution for caching mandatory data with Redis.
+--   
+--   In many cases, requires not just pick up or put the data into the cache.
+--   As a rule, data are required. 
+--   
+--   ... check the cache ... if the value is missing, run the calculations ... 
+--   put value to cache ... Tedious
+--   
+--   Solution is quite simple - collapse all of these steps in one operation.
+module Database.Redis.Pile (
+    pile
+) where
+
+import qualified Data.ByteString as B
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (void)
+
+import qualified Database.Redis as R
+import qualified Database.Redis.Tags as RT
+
+-- | Stores computation results in Redis as hashSet. Computation fires only  
+--   if data absent in cache. Of course, to refresh the data, they must first 
+--   remove from the cache.
+--   
+--   Computation controls all that will be stored in the cache. To do this, 
+--   except the results of computation, it may return optional @TTL@ in 
+--   seconds (Redis convention) and tags for key. About tags see 
+--   "Database.Redis.Tags".
+--   
+--   Instead get all data from cache, optional parameter allows simply make 
+--   sure that cache holds HashSet with needed field with needed value. If this 
+--   is so, 'pile' return 'Nothing'. 
+--
+-- > conn <- connect defaultConnectInfo
+-- > runRedis conn $ do
+-- >    -- do it
+-- >    r <- pile "mykey" (Just ("etag", "etag")) $  
+-- >        return ([("etag", "etag"), ("val", "myval")], Nothing, Nothing)
+-- >    liftIO $ print r
+-- >    -- Just [("etag", "etag"), ("val", "myval")]
+-- >    
+-- >    -- once again
+-- >    r <- pile "mykey" (Just ("etag", "etag")) $  
+-- >        return ([("etag", "etag"), ("val", "myval")], Nothing, Nothing)
+-- >    liftIO $ print r
+-- >    -- Nothing
+-- >    
+-- >    -- and again without expect
+-- >    r <- pile "mykey" Nothing $  
+-- >        return ([("etag", "etag"), ("val", "myval")], Nothing, Nothing)
+-- >    liftIO $ print r
+-- >    -- Just [("etag", "etag"), ("val", "myval")]
+pile :: 
+       B.ByteString        
+            -- ^ Key in cache.
+    -> Maybe (B.ByteString, B.ByteString)
+            -- ^ Optional expect field.
+    -> IO ([(B.ByteString, B.ByteString)], 
+           Maybe Integer, 
+           Maybe (B.ByteString, [B.ByteString]))
+            -- ^ Computation that returns data and 
+            --   optional TTL and tags.
+    -> R.Redis (Maybe [(B.ByteString, B.ByteString)])
+pile key (Just (ef, ev)) f = do
+    e <- R.hget key ef
+    case e of
+        Right (Just ev') | ev' == ev -> return Nothing
+                         | otherwise -> pile key Nothing f
+        _ -> pile key Nothing f
+pile key Nothing f = do
+    d <- R.hgetall key
+    case d of
+        Right [] -> runF
+        Right r -> return $ Just r
+        _ -> runF
+  where
+    runF = do
+        (r, ke, t) <- liftIO f
+        void $ R.hmset key r
+        setExpire ke
+        setTags t
+        return $ Just r
+      where
+        setExpire Nothing = return ()
+        setExpire (Just ke) = void $ R.expire key ke
+        setTags Nothing = return ()
+        setTags (Just (p, ts)) = RT.markTags [key] p ts
+
+ test/Database/Redis/Test/Pile.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Database.Redis.Test.Pile (tests) where
+
+import Test.Framework (testGroup, mutuallyExclusive, Test)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@=?))
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
+import Control.Exception.Lifted (bracket_)
+
+import qualified Data.ByteString as B
+
+import qualified Database.Redis as R
+import qualified Database.Redis.Pile as RP
+
+tests :: Test
+tests = mutuallyExclusive $ testGroup "Pile" [
+    testCase "New Data" caseNewData,
+    testCase "Stored data" caseStoredData
+    ]
+
+caseNewData :: Assertion
+caseNewData = bracket_
+    setup
+    teardown
+    $ runInRedis $ do
+        r <- RP.pile (allPrefix "two") Nothing $ 
+            return (allData, Nothing, Nothing)
+        liftIO $ Just allData @=? r
+        void $ RP.pile (allPrefix "three") Nothing $ 
+            return (allData, Just 15, Just ("piletest:", ["one"]))
+        ex <- R.ttl (allPrefix "three")
+        liftIO $ Right 15 @=? ex
+
+caseStoredData :: Assertion
+caseStoredData = bracket_
+    setup
+    teardown
+    $ runInRedis $ do
+        r <- RP.pile (allPrefix "one") Nothing $ 
+            return (allData, Nothing, Nothing)
+        liftIO $ Just allData @=? r
+        r' <- RP.pile (allPrefix "one") (Just ("etag", "etag")) $ 
+            return (allData, Nothing, Nothing)
+        liftIO $ Nothing @=? r'
+
+runInRedis :: forall b. R.Redis b -> IO b
+runInRedis a = do
+    conn <- R.connect R.defaultConnectInfo
+    R.runRedis conn a
+    
+setup :: IO ()
+setup = runInRedis $ 
+    void $ R.hmset "piletest:one" allData
+
+-- | Purge all keys with 'allPrefix'
+teardown :: IO ()
+teardown = runInRedis $ do
+    a <- R.keys $ allPrefix "*"
+    _ <- either undefined R.del a
+    return ()
+    
+allPrefix :: B.ByteString -> B.ByteString
+allPrefix = B.append "piletest:"
+
+allData :: [(B.ByteString, B.ByteString)]
+allData = [("etag", "etag"), ("anydata", "anydata")]
+ test/Main.hs view
@@ -0,0 +1,12 @@+
+module Main (main) where
+
+import Test.Framework (defaultMain)
+
+import qualified Database.Redis.Test.Pile
+
+main :: IO ()
+main = defaultMain [
+    Database.Redis.Test.Pile.tests
+    ]
+