diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,33 @@ +2010-07-15 oleg + * Version 0.2. + +2010-07-14 oleg + * NEWS: Updated. + * memcached.cabal: Updated version, maintainer and + extra-source-files, fixed build-depends. + +2010-07-14 oleg + * Network/Memcache/Serializable.hs (Serializable): Support + ByteString. Serialize all types to ByteString instead of String. + Encode/decode strings to/from UTF8. + (toString, fromString, toStringL, fromStringL): Renamed to + serialize, deserialize, serializeL, deserializeL. Updated all + references. + + * Network/Memcache/Protocol.hs: Store all values in memcache as + ByteString's. + (hGetNetLn): Rewrote to use hGetLine. + + * memcached.cabal: Depend on the bytestring and utf8-light packages. + +2010-07-13 oleg + * README: New file. + +2010-07-13 oleg + * ChangeLog, NEWS: New files. + +2010-07-13 oleg + * Added .gitignore. + +2010-07-13 oleg + * Initial commit (version 0.1.2) diff --git a/Demo.lhs b/Demo.lhs --- a/Demo.lhs +++ b/Demo.lhs @@ -59,8 +59,8 @@ For more complicated data, you can do whatever crazy bitpacking necessary. > instance Serializable User where -> toString (User username fontsize) = username ++ " " ++ (show fontsize) -> fromString str = case words str of +> serialize (User username fontsize) = username ++ " " ++ (show fontsize) +> deserialize str = case words str of > (a:b:[]) -> Just (User a (read b)) > _ -> Nothing diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,4 @@ +0.2 (July 15, 2010) + +* Store strings as UTF8-encoded ByteStrings, to avoid garbling + Unicode strings. diff --git a/Network/Memcache/Protocol.hs b/Network/Memcache/Protocol.hs --- a/Network/Memcache/Protocol.hs +++ b/Network/Memcache/Protocol.hs @@ -15,6 +15,8 @@ import Network.Memcache.Key import Network.Memcache.Serializable import System.IO +import qualified Data.ByteString as B +import Data.ByteString (ByteString) -- | Gather results from action until condition is true. ioUntil :: (a -> Bool) -> IO a -> IO [a] @@ -28,12 +30,13 @@ hPutNetLn :: Handle -> String -> IO () hPutNetLn h str = hPutStr h (str ++ "\r\n") +-- | Put out a line with \r\n terminator. +hBSPutNetLn :: Handle -> ByteString -> IO () +hBSPutNetLn h str = B.hPutStr h str >> hPutStr h "\r\n" + -- | Get a line, stripping \r\n terminator. hGetNetLn :: Handle -> IO [Char] -hGetNetLn h = do - str <- ioUntil (== '\r') (hGetChar h) - hGetChar h -- read following newline - return str +hGetNetLn h = fmap init (hGetLine h) -- init gets rid of \r -- | Put out a command (words with terminator) and flush. hPutCommand :: Handle -> [String] -> IO () @@ -65,22 +68,22 @@ store action (Server handle) key val = do let flags = (0::Int) let exptime = (0::Int) - let valstr = toString val - let bytes = length valstr + let valstr = serialize val + let bytes = B.length valstr let cmd = unwords [action, toKey key, show flags, show exptime, show bytes] hPutNetLn handle cmd - hPutNetLn handle valstr + hBSPutNetLn handle valstr hFlush handle response <- hGetNetLn handle return (response == "STORED") -getOneValue :: Handle -> IO (Maybe String) +getOneValue :: Handle -> IO (Maybe ByteString) getOneValue handle = do s <- hGetNetLn handle case words s of ["VALUE", _, _, sbytes] -> do let count = read sbytes - val <- sequence $ take count (repeat $ hGetChar handle) + val <- B.hGet handle count return $ Just val _ -> return Nothing @@ -106,7 +109,7 @@ Just val -> do hGetNetLn handle hGetNetLn handle - return $ fromString val + return $ deserialize val delete (Server handle) key delta = do hPutCommand handle [toKey key, show delta] diff --git a/Network/Memcache/Serializable.hs b/Network/Memcache/Serializable.hs --- a/Network/Memcache/Serializable.hs +++ b/Network/Memcache/Serializable.hs @@ -1,47 +1,56 @@ -- Memcached interface. -- Copyright (C) 2005 Evan Martin -module Network.Memcache.Serializable(Serializable, toString, fromString) where +module Network.Memcache.Serializable(Serializable, serialize, deserialize) where +import Data.ByteString (ByteString) +import Codec.Binary.UTF8.Light (encode, decode) + -- It'd be nice to use "show" for serialization, but when we -- serialize a String we want to serialize it without the quotes. -- TODO: -- - allow serializing bytes as Ptr -- to do this, add a "putToHandle", etc. method in Serializable --- where the default uses toString, but for Ptr uses socket stuff. +-- where the default uses serialize, but for Ptr uses socket stuff. --import Foreign.Marshal.Utils --import Foreign.Storable (Storable, sizeOf) class Serializable a where - toString :: a -> String - fromString :: String -> Maybe a + serialize :: a -> ByteString + deserialize :: ByteString -> Maybe a - toStringL :: [a] -> String - fromStringL :: String -> [a] + serializeL :: [a] -> ByteString + deserializeL :: ByteString -> [a] - toStringL = error "unimp" - fromStringL = error "unimp" + serializeL = error "unimp" + deserializeL = error "unimp" instance Serializable Char where -- people will rarely want to serialize a single char, -- but we define them for completeness. - toString x = [x] - fromString (c:[]) = Just c - fromString _ = Nothing + serialize x = encode [x] + deserialize s = + case decode s of + (c:[]) -> Just c + _ -> Nothing -- the real use is for serializing strings. - toStringL = id - fromStringL = id + serializeL = encode + deserializeL = decode +instance Serializable ByteString where + serialize = id + deserialize = Just + -- ...do I really need to copy everything instance of Show? instance Serializable Int where - toString = show - fromString = Just . read + serialize = encode . show + deserialize = Just . read . decode instance (Serializable a) => Serializable [a] where - toString = toStringL - fromString = Just . fromStringL + serialize = serializeL + deserialize = Just . deserializeL -- vim: set ts=2 sw=2 et : diff --git a/memcached.cabal b/memcached.cabal --- a/memcached.cabal +++ b/memcached.cabal @@ -1,5 +1,5 @@ name: memcached -version: 0.1.2 +version: 0.2 stability: Alpha synopsis: haskell bindings for memcached description: haskell bindings for memcached @@ -7,15 +7,30 @@ license: OtherLicense license-file: LICENSE author: Evan Martin -maintainer: Alson Kemp -homepage: http://neugierig.org/software/darcs/browse/?r=haskell-memcached;a=summary - -build-depends: base>3 && <5, network +maintainer: Janrain +homepage: http://github.com/olegkat/haskell-memcached build-type: Simple -extra-source-files: Test.hs, Demo.lhs + tested-with: GHC==6.8.2, GHC==6.10 -exposed-modules: Network.Memcache, Network.Memcache.Protocol, Network.Memcache.Serializable, - Network.Memcache.ServerPool, Network.Memcache.Key +build-depends: + base >3 && <5, + network, + bytestring >=0.9 && <0.10, + utf8-light >=0.4 && <1.0 + +extra-source-files: + Setup.hs, + Test.hs, + Demo.lhs, + ChangeLog, + NEWS + +exposed-modules: + Network.Memcache, + Network.Memcache.Protocol, + Network.Memcache.Serializable, + Network.Memcache.ServerPool, + Network.Memcache.Key ghc-prof-options: -prof -auto-all