Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

71 lines (59 sloc) 2.326 kb
{-# LANGUAGE OverloadedStrings #-}
import Network
import Control.Applicative
import Control.Concurrent (forkIO)
import Control.Monad (forever)
import Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 (endOfLine, char, isSpace_w8, decimal, signed)
import Data.Attoparsec.Enumerator
import Data.ByteString.Char8 as C
import Data.Enumerator as E
import System.IO
import System.Environment
import qualified Data.ByteString as B
import qualified Data.Enumerator.List as EL
import qualified Data.Enumerator.Binary as EB
import qualified Data.HashTable.IO as H
type HashTable = H.BasicHashTable Key Value
type Key = ByteString
type Value = ByteString
data Command = Get Key | Set Key Value deriving Show
command :: Parser Command
command = (word >>= mkCommand) <* endOfLine where
mkCommand "get" = Get <$> word
mkCommand "set" = Set <$> word <* extra <*> value
mkCommand cmd = fail $ "invalid command: " ++ C.unpack cmd
word = takeWhile1 (not.isSpace_w8) <* optional space
value = decimal >>= (endOfLine *>) . A.take
extra = number >> number >> return ()
number = signed decimal >> space
space = char ' '
serve :: Socket -> HashTable -> IO ()
serve socket table = acceptConn where
acceptConn = do
(handle,_,_) <- accept socket
hSetBuffering handle LineBuffering
_ <- forkIO $ serveClient handle
return ()
serveClient handle = exec $ commands $$ respond where
exec i = run i >> return ()
commands = EB.enumHandle 1024 handle $= E.sequence (iterParser command)
respond = EL.concatMapM response =$ EB.iterHandle handle
response (Get key) = do
val <- lookup key
case val of
Just val -> do
let len = C.pack . show . B.length $ val
return ["VALUE ", key, " 0 ", len, "\n", val, "\nEND\n"]
Nothing -> return ["END\n"]
response (Set key value) = insert key value >> return ["STORED\n"]
insert = H.insert table
lookup = H.lookup table
main :: IO ()
main = withSocketsDo $ do
socket <- listenOn (PortNumber 11211)
table <- H.new
args <- getArgs
case args of
["--single"] -> serve socket table
_ -> forever $ serve socket table
Jump to Line
Something went wrong with that request. Please try again.