Serialize all values to ByteString, to avoid garbling Unicode strings…

…. Encode strings in UTF8.

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.

ChangeLog

@@ -1,3 +1,17 @@
+2010-07-14  oleg <oleg@janrain.com>
+	* 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 <oleg@janrain.com>
 	* README:  New file.
 

Demo.lhs

@@ -59,8 +59,8 @@ For this simple type we can stringify it as just "username fontsize".
 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
 

Network/Memcache/Protocol.hs

@@ -15,6 +15,8 @@ import qualified Network
 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 @@ ioUntil stop io = do
 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 :: (Key k, Serializable s) => String -> Server -> k -> s -> IO Bool
 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 @@ instance Memcache Server where
       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]

Network/Memcache/Serializable.hs

@@ -1,47 +1,56 @@
 -- Memcached interface.
 -- Copyright (C) 2005 Evan Martin <martine@danga.com>
 
-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 :

memcached.cabal

@@ -10,7 +10,7 @@ author:              Evan Martin <martine@danga.com>
 maintainer:          Alson Kemp <alson@alsonkemp.com>
 homepage:            http://neugierig.org/software/darcs/browse/?r=haskell-memcached;a=summary
 
-build-depends:       base>3 && <5, network
+build-depends:       base>3 && <5, network, bytestring==0.9.*, utf8-light>=0.4 && <1.0
 build-type:          Simple
 extra-source-files:  Test.hs, Demo.lhs
 tested-with:         GHC==6.8.2, GHC==6.10