Home

Copyright © 2009 Andrew Stein

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.

REDIS.LHS – an excercise in over engineering
______________________________________________________________________

Redis.lhs is a Haskell library for interfacing with, obviously, Redis
(http://code.google.com/p/redis), a fast key-value storage server.
With it, you can doo cool stuff like this:

globalUserId = “global:nextUserId” newtype Username = Username String newtype Password = Password String instance Key Username where unkey (Username id) = "uid: + id + “:username” instance Key Password where unkey (Password id) = "uid: + id + “:password” createUser name pass = run db $ do next <- incr globalUserId set (Username next) user set (Password next) pass

… and other stuff I’m no privileged to talk about. Yet. Because
I’m still coding it. What was that? You want to talk shit? Fuck you.

So anyway: here we are, empty source file. Gonna need a name of some
kind …

> module Redis (Redis, run, query) where

There we are. Anything else we might need?

> {-# LANGUAGE TypeSynonymInstances #-}
> {-# LANGUAGE FlexibleInstances #-}

Fucking fancy! Language pragmas, in my source file! I’m honored.
Anyone else?

> import qualified Data.Set as S
> import Network
> import System.IO
> import Text.ParserCombinators.Parsec

Oh, you fuckers. Way to conflict with every name in the prelude,
Data.Set. You can fucking die in fire.

CONTAINER – in which the author “totally wails on this one dude”
______________________________________________________________________

> newtype Server = Server [(String, PortNumber)]
> newtype Redis a = Redis { unRedis :: Handle > IO a }
>
> db = Server [(“127.0.0.1”, 6379)]
>
> run :: Server → Redis a → IO a
> run (Server ((ip,port):_)) redis = do handle < connectTo ip (PortNumber port)
> r <- hRun handle redis
> hFlush handle >> (r `seq` hClose handle)
> return r
>
> hRun :: Handle > Redis a → IO a
> hRun handle (Redis q) = do hSetBuffering handle NoBuffering
> q handle
>
> query :: Response a =>
> String → Redis a
> query exec = Redis $ \ handle → do { hPutStr handle exec
> ; hPutStr handle “\r\n”
> ; x < hGetContents handle
> ; return $ response x }
>
> bulk :: String → String
> bulk text = (show $ length text) + “\r\n” + text
>
> instance Monad Redis where
> return x = Redis $ \ ______ → return x
> r >>= f = Redis $ \ handle → ((unRedis r) handle >>= (($ handle) . unRedis . f))
>
> instance Functor Redis where
> fmap f r = Redis $ \ handle → ((unRedis r) handle >>= (return . f))

PARSING
________________________________________________________________________________

Of course, we want to be able to read the Redis instance’s response from our queries -

> data Void = Ok | Error String
> deriving (Show)
>
> data RedisType = RString
> deriving (Show)
>
> class Response a where
> parser :: Parser a
> response :: String > a
> response text = case parse parser “Response” text of
> (Right x) → x
>
> instance Response String where
> parser = anyChar `manyTill` string “\r\n”
>
>
> instance Response Void where
> parser = (char ’’ >> parser >>= (return . Error)) <|> (char ‘+’ >> return Ok)
>
> instance Response Int where
> parser = do char ‘:’ <|> return ‘:’
> x <- digit `manyTill` string “\r\n”
> return $ read x
>
> instance Response [String] where
> parser = do char ‘$’
> x <- parser
> y <- count x anyChar
> return $ words y
>
> instance (Ord a, Response a) => Response (S.Set a) where
> parser = do char ‘*’
> x <- parser
> y <- count (read x) $ char ‘$’ >> (parser :: Parser String) >> parser
> return $ S.fromList y
>
> instance Response Bool where
> parser = do char ‘:’
> x <- parser
> case x of
> “1” > return True
> “0” → return False
>
> instance Response RedisType where
> parser = do char ‘+’
> x < parser
> return $ case x of
> “string” → RString

DSL – acronyms are for losers
______________________________________________________________________

Finally, we have a domain specific language (DSL) for expressing Redis
commands, ala (http://code.google.com/p/redis/wiki/CommandReference).
These functions simple leverage the redis function to convert a string
query into a (Redis a), suitable for composition and manipulation via
Haskell’s standard monadic tools

Connection handling

> quit :: Redis ()
> auth :: String → Redis Void
>
> quit = query “QUIT”
> auth pass = query $ "AUTH " ++ pass

Commands operating on all the kind of values

> exists :: String → Redis Bool
> del :: String → Redis Bool
> set :: String → String → Redis Void
> type’ :: String → Redis RedisType
> keys :: String → Redis [String]
> randomkey :: Redis String
> rename :: String → String → Redis Void
> renamenx :: String → String → Redis Void
> dbsize :: Redis Int
> expire :: String → Int → Redis Bool
> ttl :: String → Redis Int
> select :: Int → Redis Void
> move :: String → Int → Redis Void
> flushdb :: Redis Void
> flushall :: Redis Void
>
> exists key = query $ "EXISTS " + key
> del key = query $ "DEL " + key
> set key val = query $ "SET " + key + " " + (bulk val)
> type’ key = query $ "TYPE " + key
> keys patt = query $ "KEYS " + patt
> randomkey = query “RANDOMKEY”
> rename oldkey newkey = query $ "RENAME " + oldkey + " " + newkey
> renamenx oldkey newkey = query $ "RENAMENX " + oldkey + " " + newkey
> dbsize = query “DBSIZE”
> expire key ttl = query $ "EXPIRE " + key + " " + (show ttl)
> ttl key = query $ "TTL " + key
> select dbid = query $ "SELECT " + (show dbid)
> move key dbid = query $ "MOVE " + key + " " ++ (show dbid)
> flushdb = query “FLUSHDB”
> flushall = query “FLUSHALL”