haskell/memcached-binary
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'develop'

Browse Source
This commit is contained in:
philopon 2014-08-27 08:44:14 +09:00
commit ab3498b35d
2 changed files with 8 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
memcached-binary.cabal
View File

@ -1,5 +1,5 @@
name: memcached-binary name: memcached-binary
version: 0.1.0.1 version: 0.1.1
synopsis: memcached client using binary protocol. synopsis: memcached client using binary protocol.
description: memcached client using binary protocol. description: memcached client using binary protocol.
license: MIT license: MIT

25
src/Database/Memcached/Binary/Internal.hs
View File

@ -16,7 +16,6 @@ import System.IO
import Control.Monad import Control.Monad
import Control.Exception import Control.Exception
import Control.Concurrent.MVar
import Data.Word import Data.Word
import Data.Pool import Data.Pool
@ -30,20 +29,15 @@ import Database.Memcached.Binary.Types
import Database.Memcached.Binary.Types.Exception import Database.Memcached.Binary.Types.Exception
import Database.Memcached.Binary.Internal.Definition import Database.Memcached.Binary.Internal.Definition
data Connection newtype Connection = Connection (Pool Handle)
= Connection (MVar Handle)
| ConnectionPool (Pool Handle)
withConnection :: ConnectInfo -> (Connection -> IO a) -> IO a withConnection :: ConnectInfo -> (Connection -> IO a) -> IO a
withConnection i m = withSocketsDo $ bracket (connect i) close m withConnection i m = withSocketsDo $ bracket (connect i) close m
connect :: ConnectInfo -> IO Connection connect :: ConnectInfo -> IO Connection
connect i = connect i = fmap Connection $
if numConnection i == 1 createPool (putStrLn "open" >> connect' i) (\h -> putStrLn "closed" >> quit h >> hClose h) 1
then fmap Connection $ connect' i >>= newMVar (connectionIdleTime i) (numConnection i)
else fmap ConnectionPool $
createPool (connect' i) (\h -> quit h >> hClose h) 1
(connectionIdleTime i) (numConnection i)
connect' :: ConnectInfo -> IO Handle connect' :: ConnectInfo -> IO Handle
connect' i = loop (connectAuth i) connect' i = loop (connectAuth i)
@ -61,15 +55,10 @@ connect' i = loop (connectAuth i)
auth a (\_ -> return h) (\_ _ -> loop as) h auth a (\_ -> return h) (\_ _ -> loop as) h
close :: Connection -> IO () close :: Connection -> IO ()
close (Connection mv) = do close (Connection p) = destroyAllResources p
h <- swapMVar mv (error "connection already closed")
quit h
hClose h
close (ConnectionPool p) = destroyAllResources p
useConnection :: (Handle -> IO a) -> Connection -> IO a useConnection :: (Handle -> IO a) -> Connection -> IO a
useConnection f (Connection mv) = withMVar mv f useConnection f (Connection p) = withResource p f
useConnection f (ConnectionPool p) = withResource p f
pokeWord8 :: Ptr a -> Word8 -> IO () pokeWord8 :: Ptr a -> Word8 -> IO ()
pokeWord8 = poke . castPtr pokeWord8 = poke . castPtr
@ -141,7 +130,7 @@ sendRequest op key elen epoke vlen vpoke opaque cas h =
type Failure a = Word16 -> S.ByteString -> IO a type Failure a = Word16 -> S.ByteString -> IO a
peekResponse :: (Ptr Header -> IO a) -> Failure a -> Handle -> IO a peekResponse :: (Ptr Header -> IO a) -> Failure a -> Handle -> IO a
peekResponse success failure h = bracket (mallocBytes 24) free $ \p -> peekResponse success failure h = allocaBytes 24 $ \p ->
hGetBuf h p 24 >> peekWord16be (plusPtr p 6) >>= \st -> hGetBuf h p 24 >> peekWord16be (plusPtr p 6) >>= \st ->
if st == 0 if st == 0
then success p then success p