{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances,
    OverloadedStrings #-}

#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif

module Database.Redis.Types where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.DeepSeq
import Data.ByteString.Char8 (ByteString, pack)
import qualified Data.ByteString.Lex.Fractional as F (readSigned, readExponential)
import qualified Data.ByteString.Lex.Integral as I (readSigned, readDecimal)
import GHC.Generics

import Database.Redis.Protocol


------------------------------------------------------------------------------
-- Classes of types Redis understands
--
class RedisArg a where
    encode :: a -> ByteString

class RedisResult a where
    decode :: Reply -> Either Reply a

------------------------------------------------------------------------------
-- RedisArg instances
--
instance RedisArg ByteString where
    encode :: ByteString -> ByteString
encode = forall a. a -> a
id

instance RedisArg Integer where
    encode :: Integer -> ByteString
encode = String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance RedisArg Double where
    encode :: Double -> ByteString
encode Double
a
        | forall a. RealFloat a => a -> Bool
isInfinite Double
a Bool -> Bool -> Bool
&& Double
a forall a. Ord a => a -> a -> Bool
> Double
0 = ByteString
"+inf"
        | forall a. RealFloat a => a -> Bool
isInfinite Double
a Bool -> Bool -> Bool
&& Double
a forall a. Ord a => a -> a -> Bool
< Double
0 = ByteString
"-inf"
        | Bool
otherwise = String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
a

------------------------------------------------------------------------------
-- RedisResult instances
--
data Status = Ok | Pong | Status ByteString
    deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Status x -> Status
$cfrom :: forall x. Status -> Rep Status x
Generic)

instance NFData Status

data RedisType = None | String | Hash | List | Set | ZSet
    deriving (Int -> RedisType -> ShowS
[RedisType] -> ShowS
RedisType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedisType] -> ShowS
$cshowList :: [RedisType] -> ShowS
show :: RedisType -> String
$cshow :: RedisType -> String
showsPrec :: Int -> RedisType -> ShowS
$cshowsPrec :: Int -> RedisType -> ShowS
Show, RedisType -> RedisType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedisType -> RedisType -> Bool
$c/= :: RedisType -> RedisType -> Bool
== :: RedisType -> RedisType -> Bool
$c== :: RedisType -> RedisType -> Bool
Eq)

instance RedisResult Reply where
    decode :: Reply -> Either Reply Reply
decode = forall a b. b -> Either a b
Right

instance RedisResult ByteString where
    decode :: Reply -> Either Reply ByteString
decode (SingleLine ByteString
s)  = forall a b. b -> Either a b
Right ByteString
s
    decode (Bulk (Just ByteString
s)) = forall a b. b -> Either a b
Right ByteString
s
    decode Reply
r               = forall a b. a -> Either a b
Left Reply
r

instance RedisResult Integer where
    decode :: Reply -> Either Reply Integer
decode (Integer Integer
n) = forall a b. b -> Either a b
Right Integer
n
    decode Reply
r           =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Reply
r) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
I.readSigned forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. RedisResult a => Reply -> Either Reply a
decode Reply
r

instance RedisResult Double where
    decode :: Reply -> Either Reply Double
decode Reply
r = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Reply
r) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
F.readSigned forall a. Fractional a => ByteString -> Maybe (a, ByteString)
F.readExponential forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. RedisResult a => Reply -> Either Reply a
decode Reply
r

instance RedisResult Status where
    decode :: Reply -> Either Reply Status
decode (SingleLine ByteString
s) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ case ByteString
s of
        ByteString
"OK"     -> Status
Ok
        ByteString
"PONG"   -> Status
Pong
        ByteString
_        -> ByteString -> Status
Status ByteString
s
    decode Reply
r = forall a b. a -> Either a b
Left Reply
r

instance RedisResult RedisType where
    decode :: Reply -> Either Reply RedisType
decode (SingleLine ByteString
s) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ case ByteString
s of
        ByteString
"none"   -> RedisType
None
        ByteString
"string" -> RedisType
String
        ByteString
"hash"   -> RedisType
Hash
        ByteString
"list"   -> RedisType
List
        ByteString
"set"    -> RedisType
Set
        ByteString
"zset"   -> RedisType
ZSet
        ByteString
_        -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Hedis: unhandled redis type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
s
    decode Reply
r = forall a b. a -> Either a b
Left Reply
r

instance RedisResult Bool where
    decode :: Reply -> Either Reply Bool
decode (Integer Integer
1)    = forall a b. b -> Either a b
Right Bool
True
    decode (Integer Integer
0)    = forall a b. b -> Either a b
Right Bool
False
    decode (Bulk Maybe ByteString
Nothing) = forall a b. b -> Either a b
Right Bool
False -- Lua boolean false = nil bulk reply
    decode Reply
r              = forall a b. a -> Either a b
Left Reply
r

instance (RedisResult a) => RedisResult (Maybe a) where
    decode :: Reply -> Either Reply (Maybe a)
decode (Bulk Maybe ByteString
Nothing)      = forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
    decode (MultiBulk Maybe [Reply]
Nothing) = forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
    decode Reply
r                   = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RedisResult a => Reply -> Either Reply a
decode Reply
r

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    (RedisResult a) => RedisResult [a] where
    decode :: Reply -> Either Reply [a]
decode (MultiBulk (Just [Reply]
rs)) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
rs
    decode Reply
r                     = forall a b. a -> Either a b
Left Reply
r
 
instance (RedisResult a, RedisResult b) => RedisResult (a,b) where
    decode :: Reply -> Either Reply (a, b)
decode (MultiBulk (Just [Reply
x, Reply
y])) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RedisResult a => Reply -> Either Reply a
decode Reply
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. RedisResult a => Reply -> Either Reply a
decode Reply
y
    decode Reply
r                         = forall a b. a -> Either a b
Left Reply
r

instance (RedisResult k, RedisResult v) => RedisResult [(k,v)] where
    decode :: Reply -> Either Reply [(k, v)]
decode Reply
r = case Reply
r of
                (MultiBulk (Just [Reply]
rs)) -> forall {a} {b}.
(RedisResult a, RedisResult b) =>
[Reply] -> Either Reply [(a, b)]
pairs [Reply]
rs
                Reply
_                     -> forall a b. a -> Either a b
Left Reply
r
      where
        pairs :: [Reply] -> Either Reply [(a, b)]
pairs []         = forall a b. b -> Either a b
Right []
        pairs (Reply
_:[])     = forall a b. a -> Either a b
Left Reply
r
        pairs (Reply
r1:Reply
r2:[Reply]
rs) = do
            a
k   <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
r1
            b
v   <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
r2
            [(a, b)]
kvs <- [Reply] -> Either Reply [(a, b)]
pairs [Reply]
rs
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (a
k,b
v) forall a. a -> [a] -> [a]
: [(a, b)]
kvs