diff --git a/Network/Memcache.hs b/Network/Memcache.hs index b973dce..f87cf90 100644 --- a/Network/Memcache.hs +++ b/Network/Memcache.hs @@ -9,7 +9,7 @@ import Network.Memcache.Key class Memcache a where set, add, replace :: (Key k, Serializable s) => a -> k -> s -> IO Bool get :: (Key k, Serializable s) => a -> k -> IO (Maybe s) - delete :: (Key k) => a -> k -> Int -> IO Bool + delete :: (Key k) => a -> k -> IO Bool incr, decr :: (Key k) => a -> k -> Int -> IO (Maybe Int) -- vim: set ts=2 sw=2 et : diff --git a/Network/Memcache/Protocol.hs b/Network/Memcache/Protocol.hs index 9ca3fd5..2fbf5c7 100644 --- a/Network/Memcache/Protocol.hs +++ b/Network/Memcache/Protocol.hs @@ -111,8 +111,8 @@ instance Memcache Server where hGetNetLn handle return $ deserialize val - delete (Server handle) key delta = do - hPutCommand handle ["delete", toKey key, show delta] + delete (Server handle) key = do + hPutCommand handle ["delete", toKey key] response <- hGetNetLn handle return (response == "DELETED") diff --git a/Test.hs b/Test.hs index 0695396..e38cc6a 100644 --- a/Test.hs +++ b/Test.hs @@ -31,6 +31,18 @@ setGetTest = TestCase $ withServerConnection $ \server -> do Nothing -> assertFailure "'foo' not found just after setting it" Just v -> assertEqual "foo value" (3 :: Int) v +deleteTest :: Test +deleteTest = TestCase $ withServerConnection $ \server -> do + let foo = 3 :: Int + success <- Network.Memcache.set server "foo2" foo + success' <- Network.Memcache.delete server "foo2" + foo' <- Network.Memcache.get server "foo2" + if (not success') + then assertFailure "delete did not succeed" + else case foo' of + Nothing -> do return () + Just v -> assertEqual "foo value" (3 :: Int) v + hashTest :: Test hashTest = TestCase $ do assertBool "hash produces different values" (hash key1 /= hash key2) @@ -46,6 +58,6 @@ main = bracket upDaemon downDaemon runTests >> return () where sleep 200 -- give it time to start up and bind. return m downDaemon = terminateProcess - runTests _ = runTestTT $ TestList [statsTest, setGetTest, hashTest] + runTests _ = runTestTT $ TestList [statsTest, setGetTest, hashTest, deleteTest] -- vim: set ts=2 sw=2 et :