1. Alvaro Videla
  2. redis-haskell

Commits

Alvaro Videla  committed 957aca9

new examples

  • Participants
  • Parent commits 25945d0
  • Branches default

Comments (0)

Files changed (3)

File Database/Redis/Protocol.hs

View file
     (Just something) -> return True
     Nothing -> return False
     
+liftM :: (Monad m) => (a -> b) -> m a -> m b
+liftM f m = m >>= \i ->
+            return (f i)
+
 getBulkReply :: (Serializable s) => Handle -> IO (Maybe s)
 getBulkReply handle = do
-  val <- readBulkReply handle
-  case val of
-    Nothing  -> return Nothing
-    Just val -> return $ fromString val
+  readBulkReply handle >>= \val ->
+    case val of
+      Nothing  -> return Nothing
+      Just val -> return $ fromString val
     
 getMultiBulkReply :: (Serializable s) => Handle -> IO (Maybe [Maybe s])
 getMultiBulkReply handle = do
 listToSerializable Nothing = Nothing
 listToSerializable (Just val) = fromString val
 
-incDec :: (Key k) => String -> Server -> k -> IO (Maybe Int)
-incDec cmd (Server handle) key = do
-  hPutCommand handle [cmd, toKey key]
-  readIntegerReply handle
-  
-incDecBy :: (Key k) => String -> Server -> k -> Int -> IO (Maybe Int)
-incDecBy cmd (Server handle) key delta = do
-  hPutCommand handle [cmd, toKey key, show delta]
-  readIntegerReply handle
-
 intReplyAsBool :: Handle -> IO (Bool)  
 intReplyAsBool handle = do
   val <- readIntegerReply handle

File Database/Redis/Strings.hs

View file
-module Database.Redis.Strings where
+module Database.Redis.Strings
+  (
+      get
+    , set
+    , getset
+    , mget
+    , setnx
+    , incr
+    , decr
+    , incrby
+    , decrby
+    , exists
+    , del
+    , rtype
+  )
+  where
 
 import Database.Redis.Protocol
 import Database.Redis.Key
 import Database.Redis.Serializable
 
+doCommand params comp handle = hPutCommand handle params >> comp handle
+
 get :: (Key k, Serializable s) => Server -> k -> IO (Maybe s)
-get (Server handle) key = do
-  hPutCommand handle ["GET", toKey key]
-  getBulkReply handle
+get (Server handle) key = doCommand ["GET", toKey key] getBulkReply handle
 
 set :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
 set = doBulkCommand "SET"
   sendBulkCommand "SETNX" handle key value
   intReplyAsBool handle
 
+incDec :: (Key k) => String -> Server -> k -> IO (Maybe Int)
+incDec cmd (Server handle) key = do
+  hPutCommand handle [cmd, toKey key]
+  readIntegerReply handle
+
+incDecBy :: (Key k) => String -> Server -> k -> Int -> IO (Maybe Int)
+incDecBy cmd (Server handle) key delta = do
+  hPutCommand handle [cmd, toKey key, show delta]
+  readIntegerReply handle
+
 incr :: (Key k) => Server -> k -> IO (Maybe Int)
 incr = incDec "INCR"
 
 decr :: (Key k) => Server -> k -> IO (Maybe Int)
 decr = incDec "DECR"
-
+  
 incrby :: (Key k) => Server -> k -> Int -> IO (Maybe Int)
 incrby = incDecBy "INCRBY"
 

File StringsExamples.hs

View file
+module RedisTest where
+
+-- import Network.Redis(Redis)
+import qualified Database.Redis as R
+import Database.Redis.Protocol as Single
+import Database.Redis.Serializable(Serializable(..))
+import Database.Redis.Key
+  
+main = do
+  server <- Single.connect "127.0.0.1" 6379
+  
+  R.set server "mykey" "value"
+  
+  doGet server "mykey"
+  
+  doGet server "nokey"
+  
+  R.setnx server "mykey" "value" >>= \val -> putStrLn $ show val
+  
+  R.setnx server "mykey2" "value" >>= \val -> putStrLn $ show val
+  
+  print_action $ R.getset server "mykey2" "value2"
+  
+  R.mget server ["mykey", "nosuchkey", "mykey2"] >>= 
+    maybe (putStrLn "MGET got nothing") (mapM_ (\h -> do putStrLn ("MGET: " ++ show (h::Maybe String) ++ ".")))
+      
+  R.incr server "incrkey" >>= \val -> print_int "INCR" val
+  R.incr server "incrkey" >>= \val -> print_int "INCR" val
+  
+  decr <- R.decr server "incrkey"
+  putStrLn ("DECR: " ++ show decr ++ ".")
+
+  incrby <- R.incrby server "incrbykey" 5
+  putStrLn ("INCRBY: " ++ show incrby ++ ".")
+
+  decrby <- R.decrby server "decrbykey" 5
+  putStrLn ("DECRBY: " ++ show decrby ++ ".")
+  
+  R.flushdb server
+  
+  Single.disconnect server
+    
+  where
+    doGet server key = R.get server key >>= maybe (putStrLn ("Non existen key: " ++ key ++ ".")) putStrLn
+    print_action f = f >>= maybe (putStrLn "something is wrong") putStrLn
+    print_int action val = putStrLn (action ++ ": " ++ show val ++ ".")