module Database.Redis.Internal
( RedisReply(..)
, ByteString
, request
, crlf
, toUTF8
, fromUTF8
) where
import Data.ByteString.UTF8 (ByteString)
import qualified Data.ByteString.UTF8 as U
import qualified Data.ByteString as B
import System.IO
data RedisReply = RedisSingle ByteString
| RedisError ByteString
| RedisInteger Int
| RedisBulk [Maybe RedisReply]
deriving (Eq, Show)
send :: Handle
-> ByteString
-> IO (Maybe RedisReply)
send h req = B.hPut h req >> B.hPut h (toUTF8 crlf) >>
hFlush h >> processReply h
request :: Handle -> [ByteString] -> IO (Maybe RedisReply)
request _ [] = return $ Just (RedisInteger 0)
request h commandList = send h $
B.concat [ bulkLength commandList
, toUTF8 crlf
, sendCommands commandList
]
where
sendCommands [] = toUTF8 " "
sendCommands (c:cs) =
B.append (B.concat
[ argLength c
, toUTF8 crlf
, c
, toUTF8 crlf
]) (sendCommands cs)
bulkLength cmds = toUTF8 $ '*' : (show $ length cmds)
argLength arg = toUTF8 $ '$' : (show $ B.length arg)
processReply :: Handle -> IO (Maybe RedisReply)
processReply h = do
reply <- fmap trim $ B.hGetLine h
case U.uncons reply of
Just ('+', rest) -> return $ Just (RedisSingle rest)
Just ('-', rest) -> return $ Just (RedisError rest)
Just (':', rest) -> integerReply rest
Just ('$', rest) -> bulkReply rest
Just ('*', rest) -> multiBulkReply rest
Just (_, _) -> return $ Nothing
Nothing -> return $ Nothing
where
trim = B.takeWhile (\c -> c /= 13 && c /= 10)
integerReply b = return $ Just $ RedisInteger $ toInt b
bulkReply b = do
body <- bulkBody $ toInt b
return $ case body of
Just x -> Just (RedisBulk [Just $ RedisSingle x])
_ -> Nothing
bulkBody (1) = return $ Nothing
bulkBody size = do
body <- B.hGet h (size + 2)
let reply = B.take size body
return $ Just reply
multiBulkReply b = do
bulks <- multiBulkReplies $ toInt b
return $ Just $ RedisBulk bulks
multiBulkReplies (1) = return $ [Nothing]
multiBulkReplies 0 = return $ [Nothing]
multiBulkReplies n = do
this <- processReply h
rest <- multiBulkReplies (n 1)
return $ (this : rest)
crlf :: String
crlf = "\r\n"
toUTF8 :: String -> ByteString
toUTF8 = U.fromString
fromUTF8 :: ByteString -> String
fromUTF8 = U.toString
toInt :: ByteString -> Int
toInt b = read (U.toString b) :: Int