{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Database.CQL.Protocol.Class (Cql (..)) where

import Control.Applicative
import Control.Arrow
import Data.Decimal
import Data.Int
import Data.IP
import Data.Text (Text)
import Data.Time
import Data.Time.Clock.POSIX
import Data.UUID (UUID)
import Database.CQL.Protocol.Types
import Prelude

import qualified Database.CQL.Protocol.Tuple.TH as Tuples

-- | A type that can be converted from and to some CQL 'Value'.
--
-- This type-class is used to map custom types to Cassandra data-types.
-- For example:
--
-- @
-- newtype MyType = MyType Int32
--
-- instance Cql MyType where
--     ctype              = Tagged IntColumn
--     toCql (MyType i)   = CqlInt i
--     fromCql (CqlInt i) = Right (MyType i)
--     fromCql _          = Left "Expected CqlInt"
-- @
class Cql a where
    -- | the column-type of @a@
    ctype :: Tagged a ColumnType
    -- | map @a@ to some CQL data-type
    toCql :: a -> Value
    -- | map a CQL value back to @a@
    fromCql :: Value -> Either String a

------------------------------------------------------------------------------
-- Bool

instance Cql Bool where
    ctype :: Tagged Bool ColumnType
ctype = ColumnType -> Tagged Bool ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BooleanColumn
    toCql :: Bool -> Value
toCql = Bool -> Value
CqlBoolean
    fromCql :: Value -> Either String Bool
fromCql (CqlBoolean Bool
b) = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
b
    fromCql Value
_              = String -> Either String Bool
forall a b. a -> Either a b
Left String
"Expected CqlBoolean."

------------------------------------------------------------------------------
-- Int8

instance Cql Int8 where
    ctype :: Tagged Int8 ColumnType
ctype = ColumnType -> Tagged Int8 ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TinyIntColumn
    toCql :: Int8 -> Value
toCql = Int8 -> Value
CqlTinyInt
    fromCql :: Value -> Either String Int8
fromCql (CqlTinyInt Int8
i) = Int8 -> Either String Int8
forall a b. b -> Either a b
Right Int8
i
    fromCql Value
_              = String -> Either String Int8
forall a b. a -> Either a b
Left String
"Expected CqlTinyInt."

------------------------------------------------------------------------------
-- Int16

instance Cql Int16 where
    ctype :: Tagged Int16 ColumnType
ctype = ColumnType -> Tagged Int16 ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
SmallIntColumn
    toCql :: Int16 -> Value
toCql = Int16 -> Value
CqlSmallInt
    fromCql :: Value -> Either String Int16
fromCql (CqlSmallInt Int16
i) = Int16 -> Either String Int16
forall a b. b -> Either a b
Right Int16
i
    fromCql Value
_               = String -> Either String Int16
forall a b. a -> Either a b
Left String
"Expected CqlSmallInt."

------------------------------------------------------------------------------
-- Int32

instance Cql Int32 where
    ctype :: Tagged Int32 ColumnType
ctype = ColumnType -> Tagged Int32 ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
IntColumn
    toCql :: Int32 -> Value
toCql = Int32 -> Value
CqlInt
    fromCql :: Value -> Either String Int32
fromCql (CqlInt Int32
i) = Int32 -> Either String Int32
forall a b. b -> Either a b
Right Int32
i
    fromCql Value
_          = String -> Either String Int32
forall a b. a -> Either a b
Left String
"Expected CqlInt."

------------------------------------------------------------------------------
-- Int64

instance Cql Int64 where
    ctype :: Tagged Int64 ColumnType
ctype = ColumnType -> Tagged Int64 ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BigIntColumn
    toCql :: Int64 -> Value
toCql = Int64 -> Value
CqlBigInt
    fromCql :: Value -> Either String Int64
fromCql (CqlBigInt Int64
i) = Int64 -> Either String Int64
forall a b. b -> Either a b
Right Int64
i
    fromCql Value
_             = String -> Either String Int64
forall a b. a -> Either a b
Left String
"Expected CqlBigInt."

------------------------------------------------------------------------------
-- Integer

instance Cql Integer where
    ctype :: Tagged Integer ColumnType
ctype = ColumnType -> Tagged Integer ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
VarIntColumn
    toCql :: Integer -> Value
toCql = Integer -> Value
CqlVarInt
    fromCql :: Value -> Either String Integer
fromCql (CqlVarInt Integer
i) = Integer -> Either String Integer
forall a b. b -> Either a b
Right Integer
i
    fromCql Value
_             = String -> Either String Integer
forall a b. a -> Either a b
Left String
"Expected CqlVarInt."

------------------------------------------------------------------------------
-- Float

instance Cql Float where
    ctype :: Tagged Float ColumnType
ctype = ColumnType -> Tagged Float ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
FloatColumn
    toCql :: Float -> Value
toCql = Float -> Value
CqlFloat
    fromCql :: Value -> Either String Float
fromCql (CqlFloat Float
f) = Float -> Either String Float
forall a b. b -> Either a b
Right Float
f
    fromCql Value
_            = String -> Either String Float
forall a b. a -> Either a b
Left String
"Expected CqlFloat."

------------------------------------------------------------------------------
-- Double

instance Cql Double where
    ctype :: Tagged Double ColumnType
ctype = ColumnType -> Tagged Double ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
DoubleColumn
    toCql :: Double -> Value
toCql = Double -> Value
CqlDouble
    fromCql :: Value -> Either String Double
fromCql (CqlDouble Double
d) = Double -> Either String Double
forall a b. b -> Either a b
Right Double
d
    fromCql Value
_             = String -> Either String Double
forall a b. a -> Either a b
Left String
"Expected CqlDouble."

------------------------------------------------------------------------------
-- Decimal

instance Cql Decimal where
    ctype :: Tagged Decimal ColumnType
ctype = ColumnType -> Tagged Decimal ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
DecimalColumn
    toCql :: Decimal -> Value
toCql = Decimal -> Value
CqlDecimal
    fromCql :: Value -> Either String Decimal
fromCql (CqlDecimal Decimal
d) = Decimal -> Either String Decimal
forall a b. b -> Either a b
Right Decimal
d
    fromCql Value
_              = String -> Either String Decimal
forall a b. a -> Either a b
Left String
"Expected CqlDecimal."

------------------------------------------------------------------------------
-- Text

instance Cql Text where
    ctype :: Tagged Text ColumnType
ctype = ColumnType -> Tagged Text ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TextColumn
    toCql :: Text -> Value
toCql = Text -> Value
CqlText
    fromCql :: Value -> Either String Text
fromCql (CqlText Text
s) = Text -> Either String Text
forall a b. b -> Either a b
Right Text
s
    fromCql Value
_           = String -> Either String Text
forall a b. a -> Either a b
Left String
"Expected CqlText."

------------------------------------------------------------------------------
-- Ascii

instance Cql Ascii where
    ctype :: Tagged Ascii ColumnType
ctype = ColumnType -> Tagged Ascii ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
AsciiColumn
    toCql :: Ascii -> Value
toCql (Ascii Text
a) = Text -> Value
CqlAscii Text
a
    fromCql :: Value -> Either String Ascii
fromCql (CqlAscii Text
a) = Ascii -> Either String Ascii
forall a b. b -> Either a b
Right (Ascii -> Either String Ascii) -> Ascii -> Either String Ascii
forall a b. (a -> b) -> a -> b
$ Text -> Ascii
Ascii Text
a
    fromCql Value
_            = String -> Either String Ascii
forall a b. a -> Either a b
Left String
"Expected CqlAscii."

------------------------------------------------------------------------------
-- IP Address

instance Cql IP where
    ctype :: Tagged IP ColumnType
ctype = ColumnType -> Tagged IP ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
InetColumn
    toCql :: IP -> Value
toCql = IP -> Value
CqlInet
    fromCql :: Value -> Either String IP
fromCql (CqlInet IP
i) = IP -> Either String IP
forall a b. b -> Either a b
Right IP
i
    fromCql Value
_           = String -> Either String IP
forall a b. a -> Either a b
Left String
"Expected CqlInet."

------------------------------------------------------------------------------
-- UUID

instance Cql UUID where
    ctype :: Tagged UUID ColumnType
ctype = ColumnType -> Tagged UUID ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
UuidColumn
    toCql :: UUID -> Value
toCql = UUID -> Value
CqlUuid
    fromCql :: Value -> Either String UUID
fromCql (CqlUuid UUID
u) = UUID -> Either String UUID
forall a b. b -> Either a b
Right UUID
u
    fromCql Value
_           = String -> Either String UUID
forall a b. a -> Either a b
Left String
"Expected CqlUuid."

------------------------------------------------------------------------------
-- UTCTime

instance Cql UTCTime where
    ctype :: Tagged UTCTime ColumnType
ctype = ColumnType -> Tagged UTCTime ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TimestampColumn

    toCql :: UTCTime -> Value
toCql = Int64 -> Value
CqlTimestamp
          (Int64 -> Value) -> (UTCTime -> Int64) -> UTCTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate
          (POSIXTime -> Int64) -> (UTCTime -> POSIXTime) -> UTCTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000)
          (POSIXTime -> POSIXTime)
-> (UTCTime -> POSIXTime) -> UTCTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

    fromCql :: Value -> Either String UTCTime
fromCql (CqlTimestamp Int64
t) =
        let (Int64
s, Int64
ms)     = Int64
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
1000
            UTCTime Day
a DiffTime
b = POSIXTime -> UTCTime
posixSecondsToUTCTime (Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s)
            ps :: Integer
ps          = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ms Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000000
        in UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either String UTCTime)
-> UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
a (DiffTime
b DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ Integer -> DiffTime
picosecondsToDiffTime Integer
ps)
    fromCql Value
_                = String -> Either String UTCTime
forall a b. a -> Either a b
Left String
"Expected CqlTimestamp."

------------------------------------------------------------------------------
-- Blob

instance Cql Blob where
    ctype :: Tagged Blob ColumnType
ctype = ColumnType -> Tagged Blob ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BlobColumn
    toCql :: Blob -> Value
toCql (Blob ByteString
b) = ByteString -> Value
CqlBlob ByteString
b
    fromCql :: Value -> Either String Blob
fromCql (CqlBlob ByteString
b) = Blob -> Either String Blob
forall a b. b -> Either a b
Right (Blob -> Either String Blob) -> Blob -> Either String Blob
forall a b. (a -> b) -> a -> b
$ ByteString -> Blob
Blob ByteString
b
    fromCql Value
_           = String -> Either String Blob
forall a b. a -> Either a b
Left String
"Expected CqlBlob."

------------------------------------------------------------------------------
-- Counter

instance Cql Counter where
    ctype :: Tagged Counter ColumnType
ctype = ColumnType -> Tagged Counter ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
CounterColumn
    toCql :: Counter -> Value
toCql (Counter Int64
c) = Int64 -> Value
CqlCounter Int64
c
    fromCql :: Value -> Either String Counter
fromCql (CqlCounter Int64
c) = Counter -> Either String Counter
forall a b. b -> Either a b
Right (Counter -> Either String Counter)
-> Counter -> Either String Counter
forall a b. (a -> b) -> a -> b
$ Int64 -> Counter
Counter Int64
c
    fromCql Value
_              = String -> Either String Counter
forall a b. a -> Either a b
Left String
"Expected CqlCounter."

------------------------------------------------------------------------------
-- TimeUuid

instance Cql TimeUuid where
    ctype :: Tagged TimeUuid ColumnType
ctype = ColumnType -> Tagged TimeUuid ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TimeUuidColumn
    toCql :: TimeUuid -> Value
toCql (TimeUuid UUID
u) = UUID -> Value
CqlTimeUuid UUID
u
    fromCql :: Value -> Either String TimeUuid
fromCql (CqlTimeUuid UUID
t) = TimeUuid -> Either String TimeUuid
forall a b. b -> Either a b
Right (TimeUuid -> Either String TimeUuid)
-> TimeUuid -> Either String TimeUuid
forall a b. (a -> b) -> a -> b
$ UUID -> TimeUuid
TimeUuid UUID
t
    fromCql Value
_               = String -> Either String TimeUuid
forall a b. a -> Either a b
Left String
"Expected TimeUuid."

------------------------------------------------------------------------------
-- [a]

instance Cql a => Cql [a] where
    ctype :: Tagged [a] ColumnType
ctype = ColumnType -> Tagged [a] ColumnType
forall a b. b -> Tagged a b
Tagged (ColumnType -> ColumnType
ListColumn (Tagged a ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag (Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype :: Tagged a ColumnType)))
    toCql :: [a] -> Value
toCql = [Value] -> Value
CqlList ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. Cql a => a -> Value
toCql
    fromCql :: Value -> Either String [a]
fromCql (CqlList [Value]
l) = (Value -> Either String a) -> [Value] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql [Value]
l
    fromCql Value
_           = String -> Either String [a]
forall a b. a -> Either a b
Left String
"Expected CqlList."

------------------------------------------------------------------------------
-- Maybe a

-- | Please note that due to the fact that Cassandra internally represents
-- empty collection type values (i.e. lists, maps and sets) as @null@, we
-- can not distinguish @Just []@ from @Nothing@ on response decoding.
instance Cql a => Cql (Maybe a) where
    ctype :: Tagged (Maybe a) ColumnType
ctype = ColumnType -> Tagged (Maybe a) ColumnType
forall a b. b -> Tagged a b
Tagged (ColumnType -> ColumnType
MaybeColumn (Tagged a ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag (Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype :: Tagged a ColumnType)))
    toCql :: Maybe a -> Value
toCql = Maybe Value -> Value
CqlMaybe (Maybe Value -> Value)
-> (Maybe a -> Maybe Value) -> Maybe a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. Cql a => a -> Value
toCql
    fromCql :: Value -> Either String (Maybe a)
fromCql (CqlMaybe (Just Value
m)) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql Value
m
    fromCql (CqlMaybe Maybe Value
Nothing)  = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    fromCql Value
_                   = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left String
"Expected CqlMaybe."

------------------------------------------------------------------------------
-- Map a b

instance (Cql a, Cql b) => Cql (Map a b) where
    ctype :: Tagged (Map a b) ColumnType
ctype = ColumnType -> Tagged (Map a b) ColumnType
forall a b. b -> Tagged a b
Tagged (ColumnType -> Tagged (Map a b) ColumnType)
-> ColumnType -> Tagged (Map a b) ColumnType
forall a b. (a -> b) -> a -> b
$ ColumnType -> ColumnType -> ColumnType
MapColumn
        (Tagged a ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag (Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype :: Tagged a ColumnType))
        (Tagged b ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag (Tagged b ColumnType
forall a. Cql a => Tagged a ColumnType
ctype :: Tagged b ColumnType))
    toCql :: Map a b -> Value
toCql (Map [(a, b)]
m)      = [(Value, Value)] -> Value
CqlMap ([(Value, Value)] -> Value) -> [(Value, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (Value, Value)) -> [(a, b)] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Value
forall a. Cql a => a -> Value
toCql (a -> Value) -> (b -> Value) -> (a, b) -> (Value, Value)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b -> Value
forall a. Cql a => a -> Value
toCql) [(a, b)]
m
    fromCql :: Value -> Either String (Map a b)
fromCql (CqlMap [(Value, Value)]
m) = [(a, b)] -> Map a b
forall a b. [(a, b)] -> Map a b
Map ([(a, b)] -> Map a b)
-> Either String [(a, b)] -> Either String (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value, Value) -> Either String (a, b))
-> [(Value, Value)] -> Either String [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Value
k, Value
v) -> (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql Value
k Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String b
forall a. Cql a => Value -> Either String a
fromCql Value
v) [(Value, Value)]
m
    fromCql Value
_          = String -> Either String (Map a b)
forall a b. a -> Either a b
Left String
"Expected CqlMap."

------------------------------------------------------------------------------
-- Set a

instance Cql a => Cql (Set a) where
    ctype :: Tagged (Set a) ColumnType
ctype = ColumnType -> Tagged (Set a) ColumnType
forall a b. b -> Tagged a b
Tagged (ColumnType -> ColumnType
SetColumn (Tagged a ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag (Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype :: Tagged a ColumnType)))
    toCql :: Set a -> Value
toCql (Set [a]
a) = [Value] -> Value
CqlSet ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. Cql a => a -> Value
toCql [a]
a
    fromCql :: Value -> Either String (Set a)
fromCql (CqlSet [Value]
a) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> Either String [a] -> Either String (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either String a) -> [Value] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql [Value]
a
    fromCql Value
_          = String -> Either String (Set a)
forall a b. a -> Either a b
Left String
"Expected CqlSet."

Tuples.genCqlInstances 16