packages feed

memcached (empty) → 0.1

raw patch · 10 files changed

+392/−0 lines, 10 filesdep +basedep +networksetup-changed

Dependencies added: base, network

Files

+ Demo.lhs view
@@ -0,0 +1,75 @@+Memcached interface.+Copyright (C) 2005 Evan Martin <martine@danga.com>++This program demonstrates the main use of the haskell-memcached API.+It's runnable directly if you have a server running on localhost:11211.++We first import the "Memcache" type class directly as well as all the+functions qualified.  The latter two imports will be explained below.++> import Network.Memcache(Memcache)+> import qualified Network.Memcache+> import Network.Memcache.Protocol as Single+> import Network.Memcache.Serializable(Serializable(..))++For this demonstration, we only use a single server.  But working with+a server pool ought to be transparent, as both single servers and the+pool are instances of the "Memcache" type class.++> main = do+>   server <- Single.connect "localhost" 11211+>   simpleDemo server+>   serializeDemo server+>   Single.disconnect server++> simpleDemo :: (Memcache mc) => mc -> IO ()+> simpleDemo memcache = do++When setting/getting keys, Haskell must be able to infer their type.+Typically, context will determine this, but if it doesn't you need+to annotate.++>   let foo = 3 :: Int+>   success <- Network.Memcache.set memcache "foo" foo+>   putStrLn ("Setting foo => 3: " ++ show success ++ ".")++Similarly for "get":+Generally this won't be a problem (the way you use the value will+make it specific) but it means that a naive "get" followed by a+"print" won't work -- there's no way to know whether you were trying+to get an Int or a String.+ +>   foo' <- Network.Memcache.get memcache "foo"+>   case foo' of+>     Nothing -> putStrLn "Retrieving foo: expired from cache?"+>     Just v  -> putStrLn ("Cached value for foo is " ++ show (v::Int) ++ ".")++++By implementing the "serializable" class, you can serialize more complicated+data structures directly.  Suppose we had a "User" record that contained+information about a user that we wanted to be able to retrieve quickly.++> data User = User {+>   username :: String,+>   fontsize :: Int+> } deriving Show++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+>                      (a:b:[]) -> Just (User a (read b))+>                      _        -> Nothing++> serializeDemo :: (Memcache mc) => mc -> IO ()+> serializeDemo memcache = do+>   let fred = User "fred" 24    -- fred likes large fonts+>   Network.Memcache.set memcache "u:fred" fred++>   fred' <- Network.Memcache.get memcache "u:fred"+>   putStrLn ("Fred is " ++ show (fred' :: Maybe User))++vim: set ts=2 sw=2 et :
+ LICENSE view
@@ -0,0 +1,22 @@+MIT License:++Copyright (c) 2005 Evan Martin <martine@danga.com>++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.+
+ Network/Memcache.hs view
@@ -0,0 +1,15 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Network.Memcache where++import Network.Memcache.Serializable+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+  incr, decr        :: (Key k) => a -> k -> Int -> IO (Maybe Int)++-- vim: set ts=2 sw=2 et :
+ Network/Memcache/Key.hs view
@@ -0,0 +1,29 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Network.Memcache.Key(Key, hash, toKey) where++import Data.List(foldl')++-- A Memcached key must be hashable (so it can be deterministically distributed+-- across multiple servers) and convertable to a string (as that's what+-- Memcached uses).++class Key a where+  hash     :: a -> Int+  toKey    :: a -> String++-- I really just want to make String an instance of Key,+-- but this is the best I can figure out.+class KeyElem a where+  num :: a -> Int+  chr :: a -> Char+instance KeyElem Char where+  num = fromEnum+  chr = id+instance (KeyElem a) => Key [a] where+  -- glib's string hash: fast and good for short strings+  hash  = foldl' (\h i -> 31*h + i) 0 . map num+  toKey = map chr++-- vim: set ts=2 sw=2 et :
+ Network/Memcache/Protocol.hs view
@@ -0,0 +1,116 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Network.Memcache.Protocol (+  Server,+  connect,disconnect,stats   -- server-specific commands+) where++-- TODO:+--  - use exceptions where appropriate for protocol errors+--  - expiration time in store++import Network.Memcache+import qualified Network+import Network.Memcache.Key+import Network.Memcache.Serializable+import System.IO++-- | Gather results from action until condition is true.+ioUntil :: (a -> Bool) -> IO a -> IO [a]+ioUntil stop io = do+  val <- io+  if stop val then return []+              else do more <- ioUntil stop io+                      return (val:more)++-- | Put out a line with \r\n terminator.+hPutNetLn :: Handle -> String -> IO ()+hPutNetLn h str = hPutStr h (str ++ "\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++-- | Put out a command (words with terminator) and flush.+hPutCommand :: Handle -> [String] -> IO ()+hPutCommand h strs = hPutNetLn h (unwords strs) >> hFlush h++newtype Server = Server { sHandle :: Handle }++-- connect :: String -> Network.Socket.PortNumber -> IO Server+connect :: Network.HostName -> Network.PortNumber -> IO Server+connect host port = do+  handle <- Network.connectTo host (Network.PortNumber port)+  return (Server handle)++disconnect :: Server -> IO ()+disconnect = hClose . sHandle++stats :: Server -> IO [(String, String)]+stats (Server handle) = do+  hPutCommand handle ["stats"]+  statistics <- ioUntil (== "END") (hGetNetLn handle)+  return $ map (tupelize . stripSTAT) statistics where+    stripSTAT ('S':'T':'A':'T':' ':x) = x+    stripSTAT x                       = x+    tupelize line = case words line of+                      (key:rest) -> (key, unwords rest)+                      []         -> (line, "")++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 cmd = unwords [action, toKey key, show flags, show exptime, show bytes]+  hPutNetLn handle cmd+  hPutNetLn handle valstr+  hFlush handle+  response <- hGetNetLn handle+  return (response == "STORED")++getOneValue :: Handle -> IO (Maybe String)+getOneValue handle = do+  s <- hGetNetLn handle+  case words s of+    ["VALUE", _, _, sbytes] -> do+      let count = read sbytes+      val <- sequence $ take count (repeat $ hGetChar handle)+      return $ Just val+    _ -> return Nothing++incDec :: (Key k) => String -> Server -> k -> Int -> IO (Maybe Int)+incDec cmd (Server handle) key delta = do+  hPutCommand handle [cmd, toKey key, show delta]+  response <- hGetNetLn handle+  case response of+    "NOT_FOUND" -> return Nothing+    x           -> return $ Just (read x)+++instance Memcache Server where+  set     = store "set"+  add     = store "add"+  replace = store "replace"++  get (Server handle) key = do+    hPutCommand handle ["get", toKey key]+    val <- getOneValue handle+    hGetNetLn handle    -- trailing \r\n+    hGetNetLn handle    -- "END"+    return (val >>= fromString)++  delete (Server handle) key delta = do+    hPutCommand handle [toKey key, show delta]+    response <- hGetNetLn handle+    return (response == "DELETED")++  incr = incDec "incr"+  decr = incDec "decr"++-- vim: set ts=2 sw=2 et :
+ Network/Memcache/Serializable.hs view
@@ -0,0 +1,47 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Network.Memcache.Serializable(Serializable, toString, fromString) where++-- 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.++--import Foreign.Marshal.Utils+--import Foreign.Storable (Storable, sizeOf)++class Serializable a where+  toString    :: a -> String+  fromString  :: String -> Maybe a++  toStringL   :: [a] -> String+  fromStringL :: String -> [a]++  toStringL   = error "unimp"+  fromStringL = 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++  -- the real use is for serializing strings.+  toStringL   = id+  fromStringL = id++-- ...do I really need to copy everything instance of Show?+instance Serializable Int where+  toString   = show+  fromString = Just . read++instance (Serializable a) => Serializable [a] where+  toString   = toStringL+  fromString = Just . fromStringL++-- vim: set ts=2 sw=2 et :
+ Network/Memcache/ServerPool.hs view
@@ -0,0 +1,11 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Network.Memcache.ServerPool where++import qualified Network.Memcache.Protocol as P++data Server = Server P.Server Int+data Pool = Pool (String -> Int)++-- vim: set ts=2 sw=2 et :
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ Test.hs view
@@ -0,0 +1,51 @@+-- Memcached interface.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Main where++import qualified Network.Memcache+import Network.Memcache.Key(hash)+import qualified Network.Memcache.Protocol as S++import Control.Exception+import System.Process+import System.IO   -- used for emulating sleep()+import Test.HUnit++withServerConnection :: (S.Server -> IO ()) -> IO ()+withServerConnection f = bracket connect disconnect f where+  connect = S.connect "localhost" 11211+  disconnect = S.disconnect++statsTest :: Test+statsTest = TestCase $ withServerConnection $ \server -> do+  stats <- S.stats server+  assertBool "stats returns multiple stats" (length stats > 10)++setGetTest :: Test+setGetTest = TestCase $ withServerConnection $ \server -> do+  let foo = 3 :: Int+  success <- Network.Memcache.set server "foo" foo+  foo' <- Network.Memcache.get server "foo"+  case foo' of+    Nothing -> assertFailure "'foo' not found just after setting it"+    Just v  -> assertEqual "foo value" (3 :: Int) v++hashTest :: Test+hashTest = TestCase $ do+  assertBool "hash produces different values" (hash key1 /= hash key2)+  where key1 = "foo"; key2 = "bar"++-- XXX hack: is there no other way to wait?+sleep :: Int -> IO ()+sleep x = hWaitForInput stdin x >> return ()++main :: IO ()+main = bracket upDaemon downDaemon runTests >> return () where+  upDaemon   = do m <- runCommand "memcached"+                  sleep 200  -- give it time to start up and bind.+                  return m+  downDaemon = terminateProcess+  runTests _ = runTestTT $ TestList [statsTest, setGetTest, hashTest]++-- vim: set ts=2 sw=2 et :
+ memcached.cabal view
@@ -0,0 +1,21 @@+name:                memcached+version:             0.1+stability:           Alpha+synopsis:            haskell bindings for memcached+category:            Network+license:             OtherLicense+license-file:        LICENSE+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, network+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++ghc-options:         -O2 -Wall+ghc-prof-options:    -prof -auto-all