hedis-pile 0.1.0 → 0.2.0

raw patch · 3 files changed

+34/−28 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hedis-pile.cabal +1/−1
• src/Database/Redis/Pile.hs +24/−18
• test/Database/Redis/Test/Pile.hs +9/−9

@@ -1,5 +1,5 @@ name:           hedis-pile
-version:        0.1.0
+version:        0.2.0
 cabal-version:  >= 1.8
 build-type:     Simple
 stability:      Experimental

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-} 
+
 -- | Solution for caching mandatory data with Redis.
 --   
 --   In many cases, requires not just pick up or put the data into the cache.
@@ -23,8 +25,9 @@ --   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 
+--   Computation controls all that will be stored in the cache except two 
+--   things: key and prefix for keys and tags. To do this, 
+--   with the results of computation, it may return optional @TTL@ in 
 --   seconds (Redis convention) and tags for key. About tags see 
 --   "Database.Redis.Tags".
 --   
@@ -35,55 +38,58 @@ -- > conn <- connect defaultConnectInfo
 -- > runRedis conn $ do
 -- >    -- do it
--- >    r <- pile "mykey" (Just ("etag", "etag")) $  
+-- >    r <- pile "myprefix" "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")) $  
+-- >    r <- pile "myprefix" "mykey" (Just ("etag", "etag")) $  
 -- >        return ([("etag", "etag"), ("val", "myval")], Nothing, Nothing)
 -- >    liftIO $ print r
 -- >    -- Nothing
 -- >    
 -- >    -- and again without expect
--- >    r <- pile "mykey" Nothing $  
+-- >    r <- pile "myprefix" "mykey" Nothing $  
 -- >        return ([("etag", "etag"), ("val", "myval")], Nothing, Nothing)
 -- >    liftIO $ print r
 -- >    -- Just [("etag", "etag"), ("val", "myval")]
 pile :: 
-       B.ByteString        
-            -- ^ Key in cache.
+       B.ByteString
+            -- ^ Prefix for key and tags.
+    -> B.ByteString        
+            -- ^ Key in cache. Key will be stored as @prefix:key@
     -> Maybe (B.ByteString, B.ByteString)
             -- ^ Optional expect field.
     -> IO ([(B.ByteString, B.ByteString)], 
            Maybe Integer, 
-           Maybe (B.ByteString, [B.ByteString]))
+           Maybe [B.ByteString])
             -- ^ Computation that returns data and 
-            --   optional TTL and tags.
+            --   optional TTL and tags. All tags will be stored as @prefix:tag@.
     -> R.Redis (Maybe [(B.ByteString, B.ByteString)])
-pile key (Just (ef, ev)) f = do
-    e <- R.hget key ef
+pile p key (Just (ef, ev)) f = do
+    e <- R.hget (p `B.append` ":" `B.append` 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
+                         | otherwise -> pile p key Nothing f
+        _ -> pile p key Nothing f
+pile p key Nothing f = do
+    d <- R.hgetall withPrefix
     case d of
         Right [] -> runF
         Right r -> return $ Just r
         _ -> runF
   where
+    withPrefix = p `B.append` ":" `B.append` key
     runF = do
         (r, ke, t) <- liftIO f
-        void $ R.hmset key r
+        void $ R.hmset withPrefix r
         setExpire ke
         setTags t
         return $ Just r
       where
         setExpire Nothing = return ()
-        setExpire (Just ke) = void $ R.expire key ke
+        setExpire (Just ke) = void $ R.expire withPrefix ke
         setTags Nothing = return ()
-        setTags (Just (p, ts)) = RT.markTags [key] p ts
+        setTags (Just ts) = RT.markTags [withPrefix] p ts
         

@@ -27,12 +27,12 @@     setup
     teardown
     $ runInRedis $ do
-        r <- RP.pile (allPrefix "two") Nothing $ 
+        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")
+        void $ RP.pile allPrefix "three" Nothing $ 
+            return (allData, Just 15, Just ["one"])
+        ex <- R.ttl $ allPrefix `B.append` ":three"
         liftIO $ Right 15 @=? ex
 
 caseStoredData :: Assertion
@@ -40,10 +40,10 @@     setup
     teardown
     $ runInRedis $ do
-        r <- RP.pile (allPrefix "one") Nothing $ 
+        r <- RP.pile allPrefix "one" Nothing $ 
             return (allData, Nothing, Nothing)
         liftIO $ Just allData @=? r
-        r' <- RP.pile (allPrefix "one") (Just ("etag", "etag")) $ 
+        r' <- RP.pile allPrefix "one" (Just ("etag", "etag")) $ 
             return (allData, Nothing, Nothing)
         liftIO $ Nothing @=? r'
 
@@ -59,12 +59,12 @@ -- | Purge all keys with 'allPrefix'
 teardown :: IO ()
 teardown = runInRedis $ do
-    a <- R.keys $ allPrefix "*"
+    a <- R.keys $ allPrefix `B.append` "*"
     _ <- either undefined R.del a
     return ()
     
-allPrefix :: B.ByteString -> B.ByteString
-allPrefix = B.append "piletest:"
+allPrefix :: B.ByteString
+allPrefix = "piletest"
 
 allData :: [(B.ByteString, B.ByteString)]
 allData = [("etag", "etag"), ("anydata", "anydata")]