-- | This  module processes  requests and replies,  and contains  some utility
-- functions. The  methods by which  requests are processed  are stylistically
-- modified versions of  those found in Alexander  Bogdanov's @redis@ package,
-- which can be found on hackage at <http://hackage.haskell.org/package/redis>

module Database.Redis.Internal
    ( RedisReply(..)
    , ByteString
    , request
    , crlf
    , toUTF8
    , fromUTF8
    , pairsToList
    ) 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)


------------------------------------------------------------------------------
-- | Sends the request
send :: Handle
     -> ByteString    -- ^ the request
     -> IO (Maybe RedisReply)
send h req = B.hPut h req >> B.hPut h (toUTF8 crlf) >> processReply h


------------------------------------------------------------------------------
-- | Formats and sends the request
request :: Handle
        -> [ByteString]  -- ^ list of requests
        -> 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)


------------------------------------------------------------------------------
-- | The main  processing function. See the guide to Redis responses here:
-- <http://code.google.com/p/redis/wiki/ProtocolSpecification>
processReply :: Handle -> IO (Maybe RedisReply)
processReply h = do
    reply <- fmap trim $ B.hGetLine h
    case U.uncons reply of
      Just ('+', rest) -> singleReply rest
      Just ('-', rest) -> errorReply 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)

    singleReply b = return $ Just $ RedisSingle b

    errorReply b = return $ Just $ RedisError b

    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) -- i.e. including crlf
        let reply = B.take size body
        return $! Just reply

    multiBulkReply b = do
        bulks <- multiBulkReplies $ toInt b
        return $! Just $ RedisBulk bulks

    multiBulkReplies (-1) = return $ []
    multiBulkReplies 0    = return $ []
    multiBulkReplies n    = do
        this <- processReply h
        rest <- multiBulkReplies (n - 1)
        return $! this : rest


------------------------------------------------------------------------------
-- | Shorthand for \"\r\n\". Redis uses CRLF.
crlf :: String
crlf = "\r\n"


------------------------------------------------------------------------------
-- | Not strictly necessary, but adds readability
toUTF8 :: String -> ByteString
toUTF8 = U.fromString


------------------------------------------------------------------------------
-- | Not strictly necessary, but adds readability
fromUTF8 :: ByteString -> String
fromUTF8 = U.toString


------------------------------------------------------------------------------
-- | Converts a UTF8 ByteString into its Int value
toInt :: ByteString -> Int
toInt b = read (U.toString b) :: Int


------------------------------------------------------------------------------
-- | Turns a list of pair tuples into a list
pairsToList :: [(a,a)] -> [a]
pairsToList [] = []
pairsToList ((a,b):rest) = a : b : pairsToList rest