{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Database.Redis.Protocol (Reply(..), reply, renderRequest) where

import Prelude hiding (error, take)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.DeepSeq
import Scanner (Scanner)
import qualified Scanner
import Data.ByteString.Char8 (ByteString)
import GHC.Generics
import qualified Data.ByteString.Char8 as B
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Read as Text
import Control.Monad (replicateM)

-- |Low-level representation of replies from the Redis server.
data Reply = SingleLine ByteString
           | Error ByteString
           | Integer Integer
           | Bulk (Maybe ByteString)
           | MultiBulk (Maybe [Reply])
         deriving (Reply -> Reply -> Bool
(Reply -> Reply -> Bool) -> (Reply -> Reply -> Bool) -> Eq Reply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reply -> Reply -> Bool
$c/= :: Reply -> Reply -> Bool
== :: Reply -> Reply -> Bool
$c== :: Reply -> Reply -> Bool
Eq, Int -> Reply -> ShowS
[Reply] -> ShowS
Reply -> String
(Int -> Reply -> ShowS)
-> (Reply -> String) -> ([Reply] -> ShowS) -> Show Reply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reply] -> ShowS
$cshowList :: [Reply] -> ShowS
show :: Reply -> String
$cshow :: Reply -> String
showsPrec :: Int -> Reply -> ShowS
$cshowsPrec :: Int -> Reply -> ShowS
Show, (forall x. Reply -> Rep Reply x)
-> (forall x. Rep Reply x -> Reply) -> Generic Reply
forall x. Rep Reply x -> Reply
forall x. Reply -> Rep Reply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reply x -> Reply
$cfrom :: forall x. Reply -> Rep Reply x
Generic)

instance NFData Reply

------------------------------------------------------------------------------
-- Request
--
renderRequest :: [ByteString] -> ByteString
renderRequest :: [ByteString] -> ByteString
renderRequest [ByteString]
req = [ByteString] -> ByteString
B.concat (ByteString
argCntByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
args)
  where
    argCnt :: ByteString
argCnt = [ByteString] -> ByteString
B.concat [ByteString
"*", Int -> ByteString
forall a. Show a => a -> ByteString
showBS ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
req), ByteString
crlf]
    args :: [ByteString]
args   = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
renderArg [ByteString]
req

renderArg :: ByteString -> ByteString
renderArg :: ByteString -> ByteString
renderArg ByteString
arg = [ByteString] -> ByteString
B.concat [ByteString
"$",  ByteString -> ByteString
argLen ByteString
arg, ByteString
crlf, ByteString
arg, ByteString
crlf]
  where
    argLen :: ByteString -> ByteString
argLen = Int -> ByteString
forall a. Show a => a -> ByteString
showBS (Int -> ByteString)
-> (ByteString -> Int) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length

showBS :: (Show a) => a -> ByteString
showBS :: a -> ByteString
showBS = String -> ByteString
B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

crlf :: ByteString
crlf :: ByteString
crlf = ByteString
"\r\n"

------------------------------------------------------------------------------
-- Reply parsers
--
{-# INLINE reply #-}
reply :: Scanner Reply
reply :: Scanner Reply
reply = do
  Char
c <- Scanner Char
Scanner.anyChar8
  case Char
c of
    Char
'+' -> Scanner Reply
string
    Char
'-' -> Scanner Reply
error
    Char
':' -> Scanner Reply
integer
    Char
'$' -> Scanner Reply
bulk
    Char
'*' -> Scanner Reply
multi
    Char
_ -> String -> Scanner Reply
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown reply type"

{-# INLINE string #-}
string :: Scanner Reply
string :: Scanner Reply
string = ByteString -> Reply
SingleLine (ByteString -> Reply) -> Scanner ByteString -> Scanner Reply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
line

{-# INLINE error #-}
error :: Scanner Reply
error :: Scanner Reply
error = ByteString -> Reply
Error (ByteString -> Reply) -> Scanner ByteString -> Scanner Reply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
line

{-# INLINE integer #-}
integer :: Scanner Reply
integer :: Scanner Reply
integer = Integer -> Reply
Integer (Integer -> Reply) -> Scanner Integer -> Scanner Reply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner Integer
forall i. Integral i => Scanner i
integral

{-# INLINE bulk #-}
bulk :: Scanner Reply
bulk :: Scanner Reply
bulk = Maybe ByteString -> Reply
Bulk (Maybe ByteString -> Reply)
-> Scanner (Maybe ByteString) -> Scanner Reply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Int
len <- Scanner Int
forall i. Integral i => Scanner i
integral
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then Maybe ByteString -> Scanner (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
    else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Scanner ByteString -> Scanner (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner ByteString
Scanner.take Int
len Scanner (Maybe ByteString)
-> Scanner () -> Scanner (Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
eol

-- don't inline it to break the circle between reply and multi
{-# NOINLINE multi #-}
multi :: Scanner Reply
multi :: Scanner Reply
multi = Maybe [Reply] -> Reply
MultiBulk (Maybe [Reply] -> Reply)
-> Scanner (Maybe [Reply]) -> Scanner Reply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Int
len <- Scanner Int
forall i. Integral i => Scanner i
integral
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then Maybe [Reply] -> Scanner (Maybe [Reply])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Reply]
forall a. Maybe a
Nothing
    else [Reply] -> Maybe [Reply]
forall a. a -> Maybe a
Just ([Reply] -> Maybe [Reply])
-> Scanner [Reply] -> Scanner (Maybe [Reply])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner Reply -> Scanner [Reply]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Scanner Reply
reply

{-# INLINE integral #-}
integral :: Integral i => Scanner i
integral :: Scanner i
integral = do
  ByteString
str <- Scanner ByteString
line
  case Reader i -> Reader i
forall a. Num a => Reader a -> Reader a
Text.signed Reader i
forall a. Integral a => Reader a
Text.decimal (ByteString -> Text
Text.decodeUtf8 ByteString
str) of
    Left String
err -> String -> Scanner i
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ShowS
forall a. Show a => a -> String
show String
err)
    Right (i
l, Text
_) -> i -> Scanner i
forall (m :: * -> *) a. Monad m => a -> m a
return i
l

{-# INLINE line #-}
line :: Scanner ByteString
line :: Scanner ByteString
line = (Char -> Bool) -> Scanner ByteString
Scanner.takeWhileChar8 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') Scanner ByteString -> Scanner () -> Scanner ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
eol

{-# INLINE eol #-}
eol :: Scanner ()
eol :: Scanner ()
eol = do
  Char -> Scanner ()
Scanner.char8 Char
'\r'
  Char -> Scanner ()
Scanner.char8 Char
'\n'