{-# 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
class RedisArg a where
encode :: a -> ByteString
class RedisResult a where
decode :: Reply -> Either Reply a
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
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
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