memcached-binary (empty) → 0.1.0
raw patch · 14 files changed
+1303/−0 lines, 14 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, containers, data-default-class, memcached-binary, network, process, resource-pool, storable-endian, test-framework, test-framework-hunit, time, unordered-containers
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- memcached-binary.cabal +54/−0
- src/Database/Memcached/Binary.hs +5/−0
- src/Database/Memcached/Binary/Common.hs +130/−0
- src/Database/Memcached/Binary/Either.hs +29/−0
- src/Database/Memcached/Binary/Header.txt +48/−0
- src/Database/Memcached/Binary/IO.hs +31/−0
- src/Database/Memcached/Binary/Internal.hs +317/−0
- src/Database/Memcached/Binary/Internal/Definition.hs +76/−0
- src/Database/Memcached/Binary/Maybe.hs +28/−0
- src/Database/Memcached/Binary/Types.hs +42/−0
- src/Database/Memcached/Binary/Types/Exception.hs +36/−0
- test/test.hs +485/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ memcached-binary.cabal view
@@ -0,0 +1,54 @@+name: memcached-binary+version: 0.1.0+synopsis: memcached client using binary protocol.+license: MIT+license-file: LICENSE+author: HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer: HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage: https://github.com/philopon/memcached-binary+Bug-reports: https://github.com/philopon/memcached-binary/issues+copyright: (c) 2014 Hirotomo Moriwaki+category: Database+build-type: Simple+cabal-version: >=1.10+extra-source-files: src/Database/Memcached/Binary/Common.hs+ src/Database/Memcached/Binary/Header.txt++library+ exposed-modules: Database.Memcached.Binary+ Database.Memcached.Binary.Maybe+ Database.Memcached.Binary.Either+ Database.Memcached.Binary.IO++ Database.Memcached.Binary.Types+ Database.Memcached.Binary.Types.Exception+ Database.Memcached.Binary.Internal+ Database.Memcached.Binary.Internal.Definition+ build-depends: base >=4.6 && <4.8+ , bytestring >=0.10 && <0.11+ , network >=2.6 && <2.7+ , storable-endian >=0.2 && <0.3+ , data-default-class >=0.0 && <0.1+ , resource-pool >=0.2 && <0.3+ , containers >=0.5 && <0.6+ , unordered-containers >=0.2 && <0.3+ , time >=1.4 && <1.5+ ghc-options: -Wall -O2+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test.hs+ ghc-options: -Wall -O2+ build-depends: base >=4.6 && <4.8+ , memcached-binary+ , test-framework >=0.8 && <0.9+ , test-framework-hunit >=0.3 && <0.4+ , process >=1.2 && <1.3+ , network >=2.6 && <2.7+ , HUnit >=1.2 && <1.3+ , data-default-class >=0.0 && <0.1+ , bytestring >=0.10 && <0.11+ default-language: Haskell2010
+ src/Database/Memcached/Binary.hs view
@@ -0,0 +1,5 @@+module Database.Memcached.Binary {-# WARNING "use Database.Memcached.Binary.Maybe(or Either, IO) instead." #-}+ ( module Database.Memcached.Binary.Maybe+ ) where++import Database.Memcached.Binary.Maybe
+ src/Database/Memcached/Binary/Common.hs view
@@ -0,0 +1,130 @@++--------------------------------------------------------------------------------++get :: Key -> I.Connection -> IO (HasReturn (Flags, Value))+get = I.useConnection . I.get (\f v -> successHasReturn (f,v)) failureHasReturn++get_ :: Key -> I.Connection -> IO (HasReturn Value)+get_ = I.useConnection . I.get (\_ v -> successHasReturn v) failureHasReturn++--------------------------------------------------------------------------------++setAddReplace :: OpCode -> Flags -> Expiry+ -> Key -> Value -> I.Connection -> IO NoReturn+setAddReplace op = \f e key value -> I.useConnection $+ I.setAddReplace successNoReturn failureNoReturn op (CAS 0) key value f e+++set :: Flags -> Expiry -> Key -> Value -> I.Connection -> IO NoReturn+set = setAddReplace opSet++add :: Flags -> Expiry -> Key -> Value -> I.Connection -> IO NoReturn+add = setAddReplace opAdd++replace :: Flags -> Expiry -> Key -> Value -> I.Connection -> IO NoReturn+replace = setAddReplace opReplace++--------------------------------------------------------------------------------++delete :: Key -> I.Connection -> IO NoReturn+delete = I.useConnection . I.delete successNoReturn failureNoReturn (CAS 0)++--------------------------------------------------------------------------------++-- | modify value in transaction.+modify :: Expiry -> Key -> (Flags -> Value -> (Flags, Value, a))+ -> I.Connection -> IO (HasReturn a)+modify e key fn = I.useConnection $ \h ->+ I.getWithCAS (\c f v -> + let (f', v', r) = fn f v+ in I.setAddReplaceWithCAS (const $ successHasReturn r)+ failureHasReturn opSet c key v' f' e h+ ) failureHasReturn key h++-- | modify value in transaction.+modify_ :: Expiry+ -> Key -> (Flags -> Value -> (Flags, Value))+ -> I.Connection -> IO NoReturn+modify_ e key fn = I.useConnection $ \h ->+ I.getWithCAS (\c f v -> + let (f', v') = fn f v+ in I.setAddReplaceWithCAS (const $ successNoReturn)+ failureNoReturn opSet c key v' f' e h+ ) failureNoReturn key h++--------------------------------------------------------------------------------++incrDecr :: OpCode -> Expiry+ -> Key -> Delta -> Initial -> I.Connection -> IO (HasReturn Counter)+incrDecr op e k d i = I.useConnection $+ I.incrDecr successHasReturn failureHasReturn op (CAS 0) k d i e++increment :: Expiry -> Key -> Delta -> Initial+ -> I.Connection -> IO (HasReturn Counter)+increment = incrDecr opIncrement++decrement :: Expiry -> Key -> Delta -> Initial+ -> I.Connection -> IO (HasReturn Counter)+decrement = incrDecr opDecrement++--------------------------------------------------------------------------------++-- | flush all value.+flushAll :: I.Connection -> IO NoReturn+flushAll = I.useConnection $ I.flushAll successNoReturn failureNoReturn++--------------------------------------------------------------------------------++version :: I.Connection -> IO (HasReturn Version)+version = I.useConnection $ I.version (\s -> case readVersion s of+ Nothing -> failureHasReturn (-1) "version parse failed"+ Just v -> successHasReturn v) failureHasReturn+ where+ readVersion s0 = do+ (x, s1) <- S8.readInt s0+ when (S8.null s1) $ Nothing+ (y, s2) <- S8.readInt (S8.tail s1)+ when (S8.null s2) $ Nothing+ (z, s3) <- S8.readInt (S8.tail s2)+ unless (S8.null s3) $ Nothing+ return (Version [x,y,z] [])+++-- | get version string.+versionString :: I.Connection -> IO (HasReturn S.ByteString)+versionString = I.useConnection $ I.version successHasReturn failureHasReturn++--------------------------------------------------------------------------------++-- | noop(use for keepalive).+noOp :: I.Connection -> IO NoReturn+noOp = I.useConnection $ I.noOp successNoReturn failureNoReturn++--------------------------------------------------------------------------------++appendPrepend :: OpCode -> Key -> Value -> I.Connection -> IO NoReturn+appendPrepend o = \k v -> I.useConnection $+ I.appendPrepend successNoReturn failureNoReturn o (CAS 0) k v++append :: Key -> Value -> I.Connection -> IO NoReturn+append = appendPrepend opAppend++prepend :: Key -> Value -> I.Connection -> IO NoReturn+prepend = appendPrepend opPrepend++--------------------------------------------------------------------------------++-- | change expiry.+touch :: Expiry -> Key -> I.Connection -> IO NoReturn+touch e k = I.useConnection $+ I.touch (\_ _ -> successNoReturn) failureNoReturn opTouch k e++-- | get value/change expiry. +getAndTouch :: Expiry -> Key -> I.Connection -> IO (HasReturn (Flags, Value))+getAndTouch e k = I.useConnection $+ I.touch (\f v -> successHasReturn (f,v)) failureHasReturn opGAT k e++-- | get value/change expiry. +getAndTouch_ :: Expiry -> Key -> I.Connection -> IO (HasReturn Value)+getAndTouch_ e k = I.useConnection $+ I.touch (\_ v -> successHasReturn v) failureHasReturn opGAT k e
+ src/Database/Memcached/Binary/Either.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE CPP #-}++module Database.Memcached.Binary.Either+#include "Header.txt"++#define NoReturn (Maybe MemcachedException)+#define HasReturn Either MemcachedException++successHasReturn :: a -> IO (HasReturn a)+successHasReturn = return . Right+{-# INLINE successHasReturn #-}++successNoReturn :: IO NoReturn+successNoReturn = return Nothing+{-# INLINE successNoReturn #-}++failureHasReturn :: I.Failure (HasReturn a)+failureHasReturn i m = return . Left $ MemcachedException i m+{-# INLINE failureHasReturn #-}++failureNoReturn :: I.Failure NoReturn+failureNoReturn i m = return . Just $ MemcachedException i m+{-# INLINE failureNoReturn #-}++#include "Common.hs"+
+ src/Database/Memcached/Binary/Header.txt view
@@ -0,0 +1,48 @@+ ( -- * connection+ I.Connection, I.withConnection, I.connect, I.close+ -- * get+ , get, get_+ -- * set+ , set, add, replace+ -- * delete+ , delete+ -- * increment/decrement+ , increment, decrement+ -- * flush+ , flushAll+ -- * version+ , version, versionString+ -- * noOp+ , noOp+ -- * append/prepend+ , append, prepend+ -- * touch+ , touch+ , getAndTouch+ , getAndTouch_++ -- * modify+ , modify, modify_+ -- * reexports+ , module Database.Memcached.Binary.Types+ , module Database.Memcached.Binary.Types.Exception+ -- | def+ , module Data.Default.Class+ -- | PortID(..)+ , module Network+ ) where++import Network(PortID(..))++import Control.Monad++import Data.Default.Class(def)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8++import Database.Memcached.Binary.Types+import Database.Memcached.Binary.Types.Exception+import Database.Memcached.Binary.Internal.Definition+import qualified Database.Memcached.Binary.Internal as I++import Data.Version
+ src/Database/Memcached/Binary/IO.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE CPP #-}++module Database.Memcached.Binary.IO+#include "Header.txt"++import Control.Exception++#define NoReturn ()+#define HasReturn++successHasReturn :: a -> IO (HasReturn a)+successHasReturn = return+{-# INLINE successHasReturn #-}++successNoReturn :: IO NoReturn+successNoReturn = return ()+{-# INLINE successNoReturn #-}++failureHasReturn :: I.Failure (HasReturn a)+failureHasReturn i m = throwIO $ MemcachedException i m+{-# INLINE failureHasReturn #-}++failureNoReturn :: I.Failure NoReturn+failureNoReturn i m = throwIO $ MemcachedException i m+{-# INLINE failureNoReturn #-}++#include "Common.hs"+
+ src/Database/Memcached/Binary/Internal.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Database.Memcached.Binary.Internal where++import Network++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Utils+import Foreign.Marshal.Alloc++import System.IO++import Control.Monad+import Control.Exception+import Control.Concurrent.MVar++import Data.Word+import Data.Pool+import Data.Storable.Endian+import qualified Data.HashMap.Strict as H+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Unsafe as S++import Database.Memcached.Binary.Types+import Database.Memcached.Binary.Types.Exception+import Database.Memcached.Binary.Internal.Definition++data Connection+ = Connection (MVar Handle)+ | ConnectionPool (Pool Handle)++withConnection :: ConnectInfo -> (Connection -> IO a) -> IO a+withConnection i m = withSocketsDo $ bracket (connect i) close m++connect :: ConnectInfo -> IO Connection+connect i =+ if numConnection i == 1+ then fmap Connection $ connect' i >>= newMVar+ else fmap ConnectionPool $ + createPool (connect' i) (\h -> quit h >> hClose h) 1 + (connectionIdleTime i) (numConnection i)++connect' :: ConnectInfo -> IO Handle+connect' i = loop (connectAuth i)+ where+ loop [] = do+ connectTo (connectHost i) (connectPort i)++ loop [a] = do+ h <- connectTo (connectHost i) (connectPort i)+ auth a (\_ -> return h) (\w m -> throwIO $ MemcachedException w m) h++ loop (a:as) = do+ h <- connectTo (connectHost i) (connectPort i)+ handle (\(_::IOError) -> loop as) $+ auth a (\_ -> return h) (\_ _ -> loop as) h++close :: Connection -> IO ()+close (Connection mv) = do+ h <- swapMVar mv (error "connection already closed")+ quit h+ hClose h+close (ConnectionPool p) = destroyAllResources p++useConnection :: (Handle -> IO a) -> Connection -> IO a+useConnection f (Connection mv) = withMVar mv f+useConnection f (ConnectionPool p) = withResource p f++pokeWord8 :: Ptr a -> Word8 -> IO ()+pokeWord8 = poke . castPtr++pokeWord16be :: Ptr a -> Word16 -> IO ()+pokeWord16be p w = poke (castPtr p) (BE w)++pokeWord32be :: Ptr a -> Word32 -> IO ()+pokeWord32be p w = poke (castPtr p) (BE w)++pokeWord64be :: Ptr a -> Word64 -> IO ()+pokeWord64be p w = poke (castPtr p) (BE w)++peekWord8 :: Ptr a -> IO Word8+peekWord8 = peek . castPtr++peekWord16be :: Ptr a -> IO Word16+peekWord16be p = peek (castPtr p) >>= \(BE w) -> return w++peekWord32be :: Ptr a -> IO Word32+peekWord32be p = peek (castPtr p) >>= \(BE w) -> return w++peekWord64be :: Ptr a -> IO Word64+peekWord64be p = peek (castPtr p) >>= \(BE w) -> return w++pokeByteString :: Ptr a -> S.ByteString -> IO ()+pokeByteString p v =+ S.unsafeUseAsCString v $ \cstr ->+ copyBytes (castPtr p) cstr (S.length v)++pokeLazyByteString :: Ptr a -> L.ByteString -> IO ()+pokeLazyByteString p v =+ void $ L.foldlChunks (\mi s -> mi >>= \i -> do+ pokeByteString (plusPtr p i) s+ return $ i + S.length s+ ) (return 0) v++data Header+data Request++mallocRequest :: OpCode -> Key -> Word8 -> (Ptr Request -> IO ())+ -> Int -> (Ptr Request -> IO ()) -> Word32 -> CAS -> IO (Ptr Request)+mallocRequest (OpCode o) key elen epoke vlen vpoke opaque (CAS cas) = do+ let tlen = S.length key + fromIntegral elen + vlen+ p <- mallocBytes (24 + fromIntegral tlen)+ pokeWord8 p 0x80+ pokeWord8 (plusPtr p 1) o+ pokeWord16be (plusPtr p 2) (fromIntegral $ S.length key)+ pokeWord8 (plusPtr p 4) elen+ pokeWord8 (plusPtr p 5) 0x00+ pokeWord16be (plusPtr p 6) 0x00+ pokeWord32be (plusPtr p 8) (fromIntegral tlen)+ pokeWord32be (plusPtr p 12) opaque+ pokeWord64be (plusPtr p 16) cas+ epoke (plusPtr p 24)+ pokeByteString (plusPtr p $ 24 + fromIntegral elen) key+ vpoke (plusPtr p $ 24 + fromIntegral elen + S.length key)+ return p+{-# INLINE mallocRequest #-}++sendRequest :: OpCode -> Key -> Word8 -> (Ptr Request -> IO ())+ -> Int -> (Ptr Request -> IO ()) -> Word32 -> CAS -> Handle -> IO ()+sendRequest op key elen epoke vlen vpoke opaque cas h =+ bracket (mallocRequest op key elen epoke vlen vpoke opaque cas) free $ \req -> do+ hPutBuf h req (24 + S.length key + fromIntegral elen + vlen)+ hFlush h+{-# INLINE sendRequest #-}++type Failure a = Word16 -> S.ByteString -> IO a++peekResponse :: (Ptr Header -> IO a) -> Failure a -> Handle -> IO a+peekResponse success failure h = bracket (mallocBytes 24) free $ \p ->+ hGetBuf h p 24 >> peekWord16be (plusPtr p 6) >>= \st ->+ if st == 0+ then success p+ else do+ bl <- peekWord32be (plusPtr p 8)+ failure st =<< S.hGet h (fromIntegral bl)+{-# INLINE peekResponse #-}++withRequest :: OpCode -> Key -> Word8 -> (Ptr Request -> IO ())+ -> Int -> (Ptr Request -> IO ()) -> CAS+ -> (Handle -> Ptr Header -> IO a) -> Failure a -> Handle -> IO a+withRequest op key elen epoke vlen vpoke cas success failure h = do+ sendRequest op key elen epoke vlen vpoke 0 cas h+ peekResponse (success h) failure h++getExtraLength :: Ptr Header -> IO Word8+getExtraLength p = peekWord8 (plusPtr p 4)++getKeyLength :: Ptr Header -> IO Word16+getKeyLength p = peekWord16be (plusPtr p 2)++getTotalLength :: Ptr Header -> IO Word32+getTotalLength p = peekWord32be (plusPtr p 8)++getCAS :: Ptr Header -> IO CAS+getCAS p = fmap CAS $ peekWord64be (plusPtr p 16)++getOpaque :: Ptr Header -> IO Word32+getOpaque p = peekWord32be (plusPtr p 12)++nop :: Ptr Request -> IO ()+nop _ = return ()++inspectResponse :: Handle -> Ptr Header + -> IO (S.ByteString, S.ByteString, L.ByteString)+inspectResponse h p = do+ el <- getExtraLength p+ kl <- getKeyLength p+ tl <- getTotalLength p+ e <- S.hGet h $ fromIntegral el+ k <- S.hGet h $ fromIntegral kl+ v <- L.hGet h $ fromIntegral tl - fromIntegral el - fromIntegral kl+ return (e,k,v)++getSuccessCallback :: (Flags -> Value -> IO a)+ -> Handle -> Ptr Header -> IO a+getSuccessCallback success h p = do+ elen <- getExtraLength p+ tlen <- getTotalLength p+ void $ hGetBuf h p 4+ flags <- peekWord32be p+ value <- L.hGet h (fromIntegral tlen - fromIntegral elen)+ success flags value++get :: (Flags -> Value -> IO a) -> Failure a+ -> Key -> Handle -> IO a+get success failure key = + withRequest opGet key 0 nop 0 nop (CAS 0)+ (getSuccessCallback success) failure++getWithCAS :: (CAS -> Flags -> Value -> IO a) -> Failure a+ -> Key -> Handle -> IO a+getWithCAS success failure key =+ withRequest opGet key 0 nop 0 nop (CAS 0)+ (\h p -> getCAS p >>= \c -> getSuccessCallback (success c) h p) failure++setAddReplace :: IO a -> Failure a -> OpCode -> CAS+ -> Key -> Value -> Flags -> Expiry -> Handle -> IO a+setAddReplace success failure o cas key value flags expiry = withRequest o key+ 8 (\p -> pokeWord32be p flags >> pokeWord32be (plusPtr p 4) expiry) + (fromIntegral $ L.length value) (flip pokeLazyByteString value) cas (\_ _ -> success) failure++setAddReplaceWithCAS :: (CAS -> IO a) -> Failure a -> OpCode -> CAS+ -> Key -> Value -> Flags -> Expiry -> Handle -> IO a+setAddReplaceWithCAS success failure o cas key value flags expiry = withRequest o key+ 8 (\p -> pokeWord32be p flags >> pokeWord32be (plusPtr p 4) expiry) + (fromIntegral $ L.length value) (flip pokeLazyByteString value) cas (\_ p -> getCAS p >>= success) failure++delete :: IO a -> Failure a -> CAS -> Key -> Handle -> IO a+delete success failure cas key =+ withRequest opDelete key 0 nop 0 nop cas (\_ _ -> success) failure++incrDecr :: (Word64 -> IO a) -> Failure a -> OpCode -> CAS+ -> Key -> Delta -> Initial -> Expiry -> Handle -> IO a+incrDecr success failure op cas key delta initial expiry =+ withRequest op key 20 extra 0 nop cas success' failure+ where+ extra p = do+ pokeWord64be p delta+ pokeWord64be (plusPtr p 8) initial+ pokeWord32be (plusPtr p 16) expiry++ success' h p = do+ void $ hGetBuf h p 8+ peekWord64be p >>= success++quit :: Handle -> IO ()+quit h = do+ sendRequest opQuit "" 0 nop 0 nop 0 (CAS 0) h+ peekResponse (\_ -> return ()) (\_ _ -> return ()) h++flushAll :: IO a -> Failure a -> Handle -> IO a+flushAll success =+ withRequest opFlush "" 0 nop 0 nop (CAS 0) (\_ _ -> success)++flushWithin :: IO a -> Failure a -> Expiry -> Handle -> IO a+flushWithin success failure w =+ withRequest opFlush "" 4 (flip pokeWord32be w) 0 nop (CAS 0)+ (\_ _ -> success) failure++noOp :: IO a -> Failure a -> Handle -> IO a+noOp success =+ withRequest opNoOp "" 0 nop 0 nop (CAS 0) (\_ _ -> success)++version :: (S.ByteString -> IO a) -> Failure a -> Handle -> IO a+version success =+ withRequest opVersion "" 0 nop 0 nop (CAS 0)+ (\h p -> getTotalLength p >>= S.hGet h . fromIntegral >>= success)++appendPrepend :: IO a -> Failure a -> OpCode -> CAS+ -> Key -> Value -> Handle -> IO a+appendPrepend success failure op cas key value = withRequest op key 0 nop+ (fromIntegral $ L.length value) (flip pokeLazyByteString value)+ cas (\_ _ -> success) failure++stats :: Handle -> IO (H.HashMap S.ByteString S.ByteString)+stats h = loop H.empty+ where+ loop m = do+ sendRequest opStat "" 0 nop 0 nop 0 (CAS 0) h+ peekResponse (success m) (\w s -> throwIO $ MemcachedException w s) h++ success m p = getTotalLength p >>= \tl ->+ if tl == 0+ then return m+ else do+ kl <- getKeyLength p+ k <- S.hGet h (fromIntegral kl)+ v <- S.hGet h (fromIntegral tl - fromIntegral kl)+ loop (H.insert k v m)++verbosity :: IO a -> Failure a -> Word32 -> Handle -> IO a+verbosity success failure v = withRequest opVerbosity ""+ 4 (flip pokeWord32be v) 0 nop (CAS 0) (\_ _ -> success) failure++touch :: (Flags -> Value -> IO a) -> Failure a -> OpCode+ -> Key -> Expiry -> Handle -> IO a+touch success failure op key e =+ withRequest op key 4 (flip pokeWord32be e) 0 nop (CAS 0)+ (getSuccessCallback success) failure++saslListMechs :: (S.ByteString -> IO a) -> Failure a+ -> Handle -> IO a+saslListMechs success failure =+ withRequest opSaslListMechs "" 0 nop 0 nop (CAS 0)+ (\h p -> getTotalLength p >>= S.hGet h . fromIntegral >>= success)+ failure++auth :: Auth -> (S.ByteString -> IO a) -> Failure a -> Handle -> IO a+auth (Plain u w) success next h = do+ sendRequest opSaslAuth "PLAIN" 0 nop (S.length u + S.length w + 2) pokeCred 0 (CAS 0) h+ peekResponse consumeResponse next h+ where+ ul = S.length u+ pokeCred p = do+ pokeWord8 p 0+ pokeByteString (plusPtr p 1) u+ pokeWord8 (plusPtr p $ ul + 1) 0+ pokeByteString (plusPtr p $ ul + 2) w++ consumeResponse p = do+ l <- getTotalLength p+ success =<< S.hGet h (fromIntegral l)
+ src/Database/Memcached/Binary/Internal/Definition.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}++module Database.Memcached.Binary.Internal.Definition where++import Foreign.Storable+import Data.Word++newtype OpCode = OpCode Word8 deriving (Storable)++#define defOpCode(n,w) n :: OpCode; n = OpCode w++defOpCode(opGet , 0x00)+defOpCode(opSet , 0x01)+defOpCode(opAdd , 0x02)+defOpCode(opReplace , 0x03)+defOpCode(opDelete , 0x04)+defOpCode(opIncrement , 0x05)+defOpCode(opDecrement , 0x06)+defOpCode(opQuit , 0x07)+defOpCode(opFlush , 0x08)+defOpCode(opGetQ , 0x09)+defOpCode(opNoOp , 0x0a)+defOpCode(opVersion , 0x0b)+defOpCode(opGetK , 0x0c)+defOpCode(opGetKQ , 0x0d)+defOpCode(opAppend , 0x0e)+defOpCode(opPrepend , 0x0f)++defOpCode(opStat , 0x10)+defOpCode(opSetQ , 0x11)+defOpCode(opAddQ , 0x12)+defOpCode(opReplaceQ , 0x13)+defOpCode(opDeleteQ , 0x14)+defOpCode(opIncrementQ , 0x15)+defOpCode(opDecrementQ , 0x16)+defOpCode(opQuitQ , 0x17)+defOpCode(opFlushQ , 0x18)+defOpCode(opAppendQ , 0x19)+defOpCode(opPrependQ , 0x1a)+defOpCode(opVerbosity , 0x1b)+defOpCode(opTouch , 0x1c)+defOpCode(opGAT , 0x1d)+defOpCode(opGATQ , 0x1e)++defOpCode(opSaslListMechs , 0x20)+defOpCode(opSaslAuth , 0x21)+defOpCode(opSaslStep , 0x22)++defOpCode(opRGet , 0x30)+defOpCode(opRSet , 0x31)+defOpCode(opRSetQ , 0x32)+defOpCode(opRAppend , 0x33)+defOpCode(opRAppendQ , 0x34)+defOpCode(opRPrepend , 0x35)+defOpCode(opRPrependQ , 0x36)+defOpCode(opRDelete , 0x37)+defOpCode(opRDeleteQ , 0x38)+defOpCode(opRIncr , 0x39)+defOpCode(opRIncrQ , 0x3a)+defOpCode(opRDecr , 0x3b)+defOpCode(opRDecrQ , 0x3c)+defOpCode(opSetVBucket , 0x3d)+defOpCode(opGetVBucket , 0x3e)+defOpCode(opDelVBucket , 0x3f)++defOpCode(opTAPConnect , 0x40)+defOpCode(opTAPMutation , 0x41)+defOpCode(opTAPDelete , 0x42)+defOpCode(opTAPFlush , 0x43)+defOpCode(opTAPOpaque , 0x44)+defOpCode(opTAPVBucketSet , 0x45)+defOpCode(opTAPCheckpointStart, 0x46)+defOpCode(opTAPCheckpointEnd , 0x47)++#undef defOpCode
+ src/Database/Memcached/Binary/Maybe.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE CPP #-}++module Database.Memcached.Binary.Maybe+#include "Header.txt"++#define NoReturn Bool+#define HasReturn Maybe++successHasReturn :: a -> IO (HasReturn a)+successHasReturn = return . Just+{-# INLINE successHasReturn #-}++successNoReturn :: IO NoReturn+successNoReturn = return True+{-# INLINE successNoReturn #-}++failureHasReturn :: I.Failure (HasReturn a)+failureHasReturn _ _ = return Nothing+{-# INLINE failureHasReturn #-}++failureNoReturn :: I.Failure NoReturn+failureNoReturn _ _ = return False+{-# INLINE failureNoReturn #-}++#include "Common.hs"
+ src/Database/Memcached/Binary/Types.hs view
@@ -0,0 +1,42 @@+module Database.Memcached.Binary.Types where++import Network++import Data.Time.Clock+import Data.Word+import Data.Default.Class+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++type User = S.ByteString+type Password = S.ByteString++data Auth+ = Plain User Password+ deriving Show++data ConnectInfo = ConnectInfo+ { connectHost :: HostName+ , connectPort :: PortID+ , connectAuth :: [Auth]+ , numConnection :: Int+ , connectionIdleTime :: NominalDiffTime+ } deriving Show++-- | +-- @+-- def = ConnectInfo "localhost" (PortNumber 11211) [] 1 20+-- @+instance Default ConnectInfo where+ def = ConnectInfo "localhost" (PortNumber 11211) [] 1 20++type Flags = Word32+type Key = S.ByteString+type Value = L.ByteString+type Expiry = Word32++newtype CAS = CAS Word64 deriving (Show)++type Delta = Word64+type Initial = Word64+type Counter = Word64
+ src/Database/Memcached/Binary/Types/Exception.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}++module Database.Memcached.Binary.Types.Exception where++import Control.Exception+import Data.Word+import Data.Typeable+import qualified Data.ByteString as S++data MemcachedException = MemcachedException+ {-# UNPACK #-} !Word16 {-# UNPACK #-} !S.ByteString+ deriving (Show, Typeable)++instance Exception MemcachedException++#define defExceptionP(n,w) n :: MemcachedException -> Bool;\+n (MemcachedException i _) = i == w++defExceptionP(isKeyNotFound , 0x01)+defExceptionP(isKeyExists , 0x02)+defExceptionP(isValueTooLarge , 0x03)+defExceptionP(isInvalidArguments , 0x04)+defExceptionP(isItemNotStored , 0x05)+defExceptionP(isIncrDecrOnNonNumeric , 0x06)+defExceptionP(isVBucketBelongsToAnotherServer , 0x07)+defExceptionP(isAuthenticationError , 0x08)+defExceptionP(isAuthenticationContinue , 0x09)+defExceptionP(isUnknownCommand , 0x81)+defExceptionP(isOutOfMemory , 0x82)+defExceptionP(isNotSupported , 0x83)+defExceptionP(isInternalError , 0x84)+defExceptionP(isBusy , 0x85)+defExceptionP(isTemporaryFailure , 0x86)++#undef defExceptionP
+ test/test.hs view
@@ -0,0 +1,485 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}++module Main (main) where++import Network+import System.Process++import Control.Exception+import Control.Concurrent+import Control.Monad++import Data.Default.Class+import Data.Maybe+import Data.Word+import Data.Typeable+import Data.Version+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L++import Database.Memcached.Binary.Types.Exception+import Database.Memcached.Binary.IO (Connection, withConnection)+import qualified Database.Memcached.Binary.IO as McIO+import qualified Database.Memcached.Binary.Maybe as McMaybe++import Test.HUnit hiding (Test)+import Test.Framework+import Test.Framework.Providers.HUnit++startMemcached :: IO ProcessHandle+startMemcached = do+ h <- spawnProcess "memcached" []+ wait (100 :: Int)+ return h+ where+ wait 0 = fail "cannot start server"+ wait i = handle (\(_ ::SomeException) -> threadDelay 100000 >> wait (i-1)) $+ void $ connectTo "localhost" $ PortNumber 11211++precond :: Connection -> IO ()+precond c = do+ McIO.flushAll c+ void $ McIO.set 0 0 "foo" "foovalue" c+ void $ McIO.set 1 0 "bar" "1234567890" c++testMc :: TestName -> (Connection -> IO ()) -> Test+testMc title m = testCase title $ withConnection def (\c -> precond c >> m c)++newtype ByPassException = ByPassException String deriving (Typeable)+instance Show ByPassException where+ show (ByPassException s) = s++instance Exception ByPassException++assertException :: Word16 -> S.ByteString -> IO a -> IO ()+assertException ex msg m =+ (m >> throwIO (ByPassException "exception not occured.")) `catch`+ (\e -> case fromException e :: Maybe MemcachedException of+ Nothing -> assertFn e+ Just e'@(MemcachedException i _) -> unless (i == ex) (assertFn e'))+ where+ assertFn e = assertFailure $ unlines+ [ "not expected exception occured:"+ , "expected: " ++ show (MemcachedException ex msg)+ , "occured: " ++ show e+ ]++testGet :: Test+testGet = testGroup "get"+ [ testGroup "IO module"+ [ testGroup "get"+ [ doTest "foo" (0, "foovalue") McIO.get+ , doTest "bar" (1, "1234567890") McIO.get+ , doTestException "notexist" McIO.get+ ]+ , testGroup "get_"+ [ doTest "foo" "foovalue" McIO.get_+ , doTest "bar" "1234567890" McIO.get_+ , doTestException "notexist" McIO.get_+ ]+ ]+ , testGroup "Maybe module"+ [ testGroup "get"+ [ doTest "foo" (Just (0, "foovalue")) McMaybe.get+ , doTest "bar" (Just (1, "1234567890")) McMaybe.get+ , doTest "notexist" Nothing McMaybe.get+ ]+ , testGroup "get_"+ [ doTest "foo" (Just "foovalue") McMaybe.get_+ , doTest "bar" (Just "1234567890") McMaybe.get_+ , doTest "notexist" Nothing McMaybe.get_+ ]+ ]+ ]+ where+ doTest key ex fn = testMc (S.unpack key) $ \c -> do+ v <- fn key c+ v @?= ex+ doTestException key fn = testMc (S.unpack key) $ \c ->+ assertException 1 "Not found" $ fn key c++testSetAddReplace :: Test+testSetAddReplace = testGroup "set/add/replace"+ [ testGroup "set"+ [ testMc "set foo to foomod" $ \c -> do+ McIO.set 100 0 "foo" "foomod" c+ v <- McIO.get "foo" c+ v @?= (100, "foomod")+ , testMc "set notexist to exist" $ \c -> do+ McIO.set 100 0 "notexist" "exist" c+ v <- McIO.get "notexist" c+ v @?= (100, "exist")+ ]+ , testGroup "add"+ [ testMc "add foo to foomod" $ \c ->+ assertException 2 "Data exists for key." $+ McIO.add 100 0 "foo" "foomod" c+ , testMc "add notexist to exist" $ \c -> do+ McIO.add 100 0 "notexist" "exist" c+ v <- McIO.get "notexist" c+ v @?= (100, "exist")+ ]+ , testGroup "replace"+ [ testMc "set foo to foomod" $ \c -> do+ McIO.replace 100 0 "foo" "foomod" c+ v <- McIO.get "foo" c+ v @?= (100, "foomod")+ , testMc "set notexist to exist" $ \c ->+ assertException 1 "Not found" $+ McIO.replace 100 0 "notexist" "exist" c+ ]+ ]++testDelete :: Test+testDelete = testGroup "delete"+ [ testGroup "IO module"+ [ testMc "foo" $ \c -> do+ McIO.delete "foo" c+ r <- McMaybe.get "foo" c+ r @?= Nothing+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $ McIO.delete "notexist" c+ ]+ , testGroup "Maybe module"+ [ testMc "foo" $ \c -> do+ b <- McMaybe.delete "foo" c+ r <- McMaybe.get "foo" c+ b @?= True+ r @?= Nothing+ , testMc "notexist" $ \c -> do+ b <- McMaybe.delete "notexist" c+ r <- McMaybe.get "notexist" c+ b @?= False+ r @?= Nothing+ ]+ ]++-- https://code.google.com/p/memcached/wiki/ReleaseNotes1417+testIncrDecr :: Version -> Test+testIncrDecr v = testGroup "increment/decrement"+ [ testGroup "IO module"+ [ testGroup "increment"+ [ testMc "foo" $ \c ->+ assertException 6 "Non-numeric server-side value for incr or decr" $+ McIO.increment 0 "foo" 10 10 c+ , testMc "bar" $ \c -> do+ a <- McIO.increment 0 "bar" 10 10 c+ b <- McIO.get_ "bar" c+ a @?= 1234567900+ b @?= "1234567900"+ , testMc "notexist" $ \c -> do+ a <- McIO.increment 0 "notexist" 10 10 c+ b <- McIO.get_ "notexist" c+ a @?= 10+ when (v >= ev) $ b @?= "10"+ ]+ , testGroup "decrement"+ [ testMc "foo" $ \c ->+ assertException 6 "Non-numeric server-side value for incr or decr" $+ McIO.decrement 0 "foo" 10 10 c+ , testMc "bar" $ \c -> do+ a <- McIO.decrement 0 "bar" 10 10 c+ b <- McIO.get_ "bar" c+ a @?= 1234567880+ b @?= "1234567880"+ , testMc "notexist" $ \c -> do+ a <- McIO.decrement 0 "notexist" 10 10 c+ b <- McIO.get_ "notexist" c+ a @?= 10+ when (v >= ev) $ b @?= "10"+ ]+ ]+ , testGroup "Maybe module"+ [ testGroup "increment"+ [ testMc "foo" $ \c -> do+ r <- McMaybe.increment 0 "foo" 10 10 c+ b <- McIO.get_ "foo" c+ r @?= Nothing+ b @?= "foovalue"+ , testMc "bar" $ \c -> do+ a <- McMaybe.increment 0 "bar" 10 10 c+ b <- McIO.get_ "bar" c+ a @?= Just 1234567900+ b @?= "1234567900"+ , testMc "notexist" $ \c -> do+ a <- McMaybe.increment 0 "notexist" 10 10 c+ b <- McIO.get_ "notexist" c+ a @?= Just 10+ when (v >= ev) $ b @?= "10"+ ]+ , testGroup "decrement'"+ [ testMc "foo" $ \c -> do+ r <- McMaybe.decrement 0 "foo" 10 10 c+ b <- McIO.get_ "foo" c+ r @?= Nothing+ b @?= "foovalue"+ , testMc "bar" $ \c -> do+ a <- McMaybe.decrement 0 "bar" 10 10 c+ b <- McIO.get_ "bar" c+ a @?= Just 1234567880+ b @?= "1234567880"+ , testMc "notexist" $ \c -> do+ a <- McMaybe.decrement 0 "notexist" 10 10 c+ b <- McIO.get_ "notexist" c+ a @?= Just 10+ when (v >= ev) $ b @?= "10"+ ]+ ]+ ]+ where+ ev = Version [1,4,17] []++testFlush :: Test+testFlush = testGroup "flush"+ [ testGroup "IO module"+ [ testMc "flushAll" $ \c -> do+ McIO.flushAll c+ a <- McMaybe.get "foo" c+ a @?= Nothing+ ]+ , testGroup "Maybe module"+ [ testMc "flushAll" $ \c -> do+ r <- McMaybe.flushAll c+ a <- McMaybe.get "foo" c+ r @?= True+ a @?= Nothing+ ]+ ]++testVersion :: Test+testVersion = testGroup "version"+ [ testGroup "versionString"+ [ testMc "IO module" $ \c -> do+ v <- McIO.versionString c+ assertBool (show v ++ " is not version like.") $ isVersionLike v+ , testMc "Maybe module" $ \c -> do+ Just v <- McMaybe.versionString c+ assertBool (show v ++ " is not version like.") $ isVersionLike v+ ]+ , testGroup "version"+ [ testMc "IO module" $ \c -> do+ v <- McIO.version c+ assertEqual "version branch length" 3 (length $ versionBranch v)+ ]+ ]+ where+ isVersionLike s0 = isJust $ do+ (_, s1) <- S.readInt s0+ unless (S.head s1 == '.') Nothing+ (_, s2) <- S.readInt (S.tail s1)+ unless (S.head s2 == '.') Nothing+ (_, s3) <- S.readInt (S.tail s2)+ unless (S.null s3) Nothing++testNoOp :: Test+testNoOp = testGroup "noOp"+ [ testMc "IO module" McIO.noOp+ , testMc "Maybe module" $ \c -> do+ b <- McMaybe.noOp c+ b @?= True+ ]++testAppendPrepend :: Test+testAppendPrepend = testGroup "append/prepend"+ [ testGroup "IO module"+ [ testGroup "append"+ [ testMc "foo" $ \c -> do+ McIO.append "foo" "!!" c+ a <- McIO.get_ "foo" c+ a @?= "foovalue!!"+ , testMc "bar" $ \c -> do+ McIO.append "bar" "!!" c+ a <- McIO.get_ "bar" c+ a @?= "1234567890!!"+ , testMc "notexist" $ \c ->+ assertException 5 "Not stored." $ McIO.append "notexist" "!!" c+ ]+ , testGroup "prepend"+ [ testMc "foo" $ \c -> do+ McIO.prepend "foo" "!!" c+ a <- McIO.get_ "foo" c+ a @?= "!!foovalue"+ , testMc "bar" $ \c -> do+ McIO.prepend "bar" "!!" c+ a <- McIO.get_ "bar" c+ a @?= "!!1234567890"+ , testMc "notexist" $ \c ->+ assertException 5 "Not stored." $ McIO.prepend "notexist" "!!" c+ ]+ ]+ , testGroup "maybe module"+ [ testGroup "append'"+ [ testMc "foo" $ \c -> do+ b <- McMaybe.append "foo" "!!" c+ a <- McIO.get_ "foo" c+ b @?= True+ a @?= "foovalue!!"+ , testMc "bar" $ \c -> do+ b <- McMaybe.append "bar" "!!" c+ a <- McIO.get_ "bar" c+ b @?= True+ a @?= "1234567890!!"+ , testMc "notexist" $ \c -> do+ b <- McMaybe.append "notexist" "!!" c+ b @?= False+ ]+ , testGroup "prepend'"+ [ testMc "foo" $ \c -> do+ b <- McMaybe.prepend "foo" "!!" c+ a <- McIO.get_ "foo" c+ b @?= True+ a @?= "!!foovalue"+ , testMc "bar" $ \c -> do+ b <- McMaybe.prepend "bar" "!!" c+ a <- McIO.get_ "bar" c+ b @?= True+ a @?= "!!1234567890"+ , testMc "notexist" $ \c -> do+ b <- McMaybe.prepend "notexist" "!!" c+ b @?= False+ ]+ ]+ ]++-- https://code.google.com/p/memcached/wiki/ReleaseNotes1414+-- https://code.google.com/p/memcached/issues/detail?id=275+testTouchGAT :: Version -> Test+testTouchGAT v = testGroup "touch/GAT"+ [ testGroup "IO module"+ [ testGroup "touch"+ [ testMc "foo" $ \c -> do+ a <- McMaybe.get_ "foo" c+ McIO.touch 1 "foo" c+ a @?= (Just "foovalue")+ when (v >= ev) $ do+ threadDelay 1100000+ b <- McMaybe.get_ "foo" c+ b @?= Nothing+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $ McIO.touch 1 "notexist" c+ ]+ , testGroup "getAndTouch"+ [ testMc "foo" $ \c -> do+ x <- McMaybe.get "foo" c+ y <- McIO.getAndTouch 1 "foo" c+ x @?= Just (0, "foovalue")+ y @?= (0, "foovalue")+ when (v >= ev) $ do+ threadDelay 1100000+ z <- McMaybe.get "foo" c+ z @?= Nothing+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $ McIO.getAndTouch 1 "notexist" c+ ]+ , testGroup "getAndTouch_"+ [ testMc "foo" $ \c -> do+ x <- McMaybe.get_ "foo" c+ y <- McIO.getAndTouch_ 1 "foo" c+ x @?= Just "foovalue"+ y @?= "foovalue"+ when (v >= ev) $ do+ threadDelay 1100000+ z <- McMaybe.get_ "foo" c+ z @?= Nothing+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $ McIO.getAndTouch_ 1 "notexist" c+ ]+ ]+ , testGroup "Maybe module"+ [ testGroup "touch"+ [ testMc "foo" $ \c -> do+ a <- McMaybe.get_ "foo" c+ r <- McMaybe.touch 1 "foo" c+ a @?= (Just "foovalue")+ r @?= True+ when (v >= ev) $ do+ threadDelay 1100000+ b <- McMaybe.get_ "foo" c+ b @?= Nothing+ , testMc "notexist" $ \c -> do+ r <- McMaybe.touch 1 "notexist" c+ a <- McMaybe.get "notexist" c+ r @?= False+ a @?= Nothing+ ]+ , testGroup "getAndTouch'/getMaybeAndTouch"+ [ testMc "foo" $ \c -> do+ a <- McMaybe.get "foo" c+ r <- McMaybe.getAndTouch 1 "foo" c+ a @?= Just (0, "foovalue")+ r @?= Just (0, "foovalue")+ when (v >= ev) $ do+ threadDelay 1100000+ b <- McMaybe.get_ "foo" c+ b @?= Nothing+ , testMc "notexist" $ \c -> do+ r <- McMaybe.getAndTouch 1 "notexist" c+ a <- McMaybe.get "notexist" c+ r @?= Nothing+ a @?= Nothing+ ]+ , testGroup "getAndTouch'_/getMaybeAndTouch_"+ [ testMc "foo" $ \c -> do+ a <- McMaybe.get_ "foo" c+ r <- McMaybe.getAndTouch_ 1 "foo" c+ a @?= Just "foovalue"+ r @?= Just "foovalue"+ when (v >= ev) $ do+ threadDelay 1100000+ b <- McMaybe.get_ "foo" c+ b @?= Nothing+ , testMc "notexist" $ \c -> do+ r <- McMaybe.getAndTouch_ 1 "notexist" c+ a <- McMaybe.get "notexist" c+ r @?= Nothing+ a @?= Nothing+ ]+ ]+ ]+ where+ ev = Version [1,4,14] []++testModify :: Test+testModify = testGroup "modify"+ [ testMc "reverse foo" $ \c -> do+ r <- McIO.modify 0 "foo" (\f v -> (f + 100, L.reverse v, v)) c+ a <- McMaybe.get "foo" c+ r @?= "foovalue"+ a @?= Just (100, "eulavoof")+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $+ McIO.modify 0 "notexist" (\f v -> (f,v,())) c+ ]++testModify_ :: Test+testModify_ = testGroup "modify_"+ [ testMc "reverse foo" $ \c -> do+ McIO.modify_ 0 "foo" (\f v -> (f + 100, L.reverse v)) c+ a <- McMaybe.get "foo" c+ a @?= Just (100, "eulavoof")+ , testMc "notexist" $ \c ->+ assertException 1 "Not found" $+ McIO.modify_ 0 "notexist" (\f v -> (f,v)) c+ ]++++main :: IO ()+main = bracket startMemcached terminateProcess $ \_ -> do+ v <- McIO.withConnection def McIO.version+ defaultMain+ [ testGet+ , testSetAddReplace+ , testDelete+ , testIncrDecr v+ , testFlush+ , testVersion+ , testNoOp+ , testAppendPrepend+ , testTouchGAT v+ , testModify+ , testModify_+ ]