{-
-- | This module processes requests and replies, and contains some utility
-- functions
-}

module Database.Redis.Internal
    ( RedisReply(..)
    , ByteString
    , request
    , crlf
    , toUTF8
    , fromUTF8
    ) where


-- import           Data.Maybe

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    -- ^ the request
     -> IO (Maybe RedisReply)
send h req = B.hPut h req >> B.hPut h (toUTF8 crlf) >>
                  hFlush h >> 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)


------------------------------------------------------------------------------
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