{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Database.CQL.Protocol.Tuple
( Tuple
, count
, check
, tuple
, store
, Row
, mkRow
, fromRow
, columnTypes
, rowLength
) where
import Control.Applicative
import Control.Monad
import Data.Functor.Identity
import Data.Serialize
import Data.Vector (Vector, (!?))
import Data.Word
import Database.CQL.Protocol.Class
import Database.CQL.Protocol.Codec (putValue, getValue)
import Database.CQL.Protocol.Tuple.TH
import Database.CQL.Protocol.Types
import Prelude
import qualified Data.Vector as Vec
data Row = Row
{ Row -> [ColumnType]
types :: ![ColumnType]
, Row -> Vector Value
values :: !(Vector Value)
} deriving (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show)
fromRow :: Cql a => Int -> Row -> Either String a
fromRow :: Int -> Row -> Either String a
fromRow Int
i Row
r =
case Row -> Vector Value
values Row
r Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
!? Int
i of
Maybe Value
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left String
"out of bounds access"
Just Value
v -> Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql Value
v
mkRow :: [(Value, ColumnType)] -> Row
mkRow :: [(Value, ColumnType)] -> Row
mkRow [(Value, ColumnType)]
xs = let ([Value]
v, [ColumnType]
t) = [(Value, ColumnType)] -> ([Value], [ColumnType])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, ColumnType)]
xs in [ColumnType] -> Vector Value -> Row
Row [ColumnType]
t ([Value] -> Vector Value
forall a. [a] -> Vector a
Vec.fromList [Value]
v)
rowLength :: Row -> Int
rowLength :: Row -> Int
rowLength Row
r = Vector Value -> Int
forall a. Vector a -> Int
Vec.length (Row -> Vector Value
values Row
r)
columnTypes :: Row -> [ColumnType]
columnTypes :: Row -> [ColumnType]
columnTypes = Row -> [ColumnType]
types
class PrivateTuple a where
count :: Tagged a Int
check :: Tagged a ([ColumnType] -> [ColumnType])
tuple :: Version -> [ColumnType] -> Get a
store :: Version -> Putter a
class PrivateTuple a => Tuple a
instance PrivateTuple () where
count :: Tagged () Int
count = Int -> Tagged () Int
forall a b. b -> Tagged a b
Tagged Int
0
check :: Tagged () ([ColumnType] -> [ColumnType])
check = ([ColumnType] -> [ColumnType])
-> Tagged () ([ColumnType] -> [ColumnType])
forall a b. b -> Tagged a b
Tagged (([ColumnType] -> [ColumnType])
-> Tagged () ([ColumnType] -> [ColumnType]))
-> ([ColumnType] -> [ColumnType])
-> Tagged () ([ColumnType] -> [ColumnType])
forall a b. (a -> b) -> a -> b
$ [ColumnType] -> [ColumnType] -> [ColumnType]
forall a b. a -> b -> a
const []
tuple :: Version -> [ColumnType] -> Get ()
tuple Version
_ [ColumnType]
_ = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
store :: Version -> Putter ()
store Version
_ = PutM () -> Putter ()
forall a b. a -> b -> a
const (PutM () -> Putter ()) -> PutM () -> Putter ()
forall a b. (a -> b) -> a -> b
$ Putter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Tuple ()
instance Cql a => PrivateTuple (Identity a) where
count :: Tagged (Identity a) Int
count = Int -> Tagged (Identity a) Int
forall a b. b -> Tagged a b
Tagged Int
1
check :: Tagged (Identity a) ([ColumnType] -> [ColumnType])
check = ([ColumnType] -> [ColumnType])
-> Tagged (Identity a) ([ColumnType] -> [ColumnType])
forall a b. b -> Tagged a b
Tagged (([ColumnType] -> [ColumnType])
-> Tagged (Identity a) ([ColumnType] -> [ColumnType]))
-> ([ColumnType] -> [ColumnType])
-> Tagged (Identity a) ([ColumnType] -> [ColumnType])
forall a b. (a -> b) -> a -> b
$ [ColumnType] -> [ColumnType] -> [ColumnType]
typecheck [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)]
tuple :: Version -> [ColumnType] -> Get (Identity a)
tuple Version
v [ColumnType]
_ = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Get a -> Get (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Tagged a ColumnType -> Get a
forall a. Cql a => Version -> Tagged a ColumnType -> Get a
element Version
v Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype
store :: Version -> Putter (Identity a)
store Version
v (Identity a
a) = do
Putter Word16
forall t. Serialize t => Putter t
put (Word16
1 :: Word16)
Version -> Putter Value
putValue Version
v (a -> Value
forall a. Cql a => a -> Value
toCql a
a)
instance Cql a => Tuple (Identity a)
instance PrivateTuple Row where
count :: Tagged Row Int
count = Int -> Tagged Row Int
forall a b. b -> Tagged a b
Tagged (-Int
1)
check :: Tagged Row ([ColumnType] -> [ColumnType])
check = ([ColumnType] -> [ColumnType])
-> Tagged Row ([ColumnType] -> [ColumnType])
forall a b. b -> Tagged a b
Tagged (([ColumnType] -> [ColumnType])
-> Tagged Row ([ColumnType] -> [ColumnType]))
-> ([ColumnType] -> [ColumnType])
-> Tagged Row ([ColumnType] -> [ColumnType])
forall a b. (a -> b) -> a -> b
$ [ColumnType] -> [ColumnType] -> [ColumnType]
forall a b. a -> b -> a
const []
tuple :: Version -> [ColumnType] -> Get Row
tuple Version
v [ColumnType]
t = [ColumnType] -> Vector Value -> Row
Row [ColumnType]
t (Vector Value -> Row)
-> ([Value] -> Vector Value) -> [Value] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
Vec.fromList ([Value] -> Row) -> Get [Value] -> Get Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ColumnType -> Get Value) -> [ColumnType] -> Get [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Version -> ColumnType -> Get Value
getValue Version
v (ColumnType -> Get Value)
-> (ColumnType -> ColumnType) -> ColumnType -> Get Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ColumnType
MaybeColumn) [ColumnType]
t
store :: Version -> Putter Row
store Version
v Row
r = do
Putter Word16
forall t. Serialize t => Putter t
put (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Row -> Int
rowLength Row
r) :: Word16)
Putter Value -> Vector Value -> PutM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
Vec.mapM_ (Version -> Putter Value
putValue Version
v) (Row -> Vector Value
values Row
r)
instance Tuple Row
element :: Cql a => Version -> Tagged a ColumnType -> Get a
element :: Version -> Tagged a ColumnType -> Get a
element Version
v Tagged a ColumnType
t = Version -> ColumnType -> Get Value
getValue Version
v (Tagged a ColumnType -> ColumnType
forall a b. Tagged a b -> b
untag Tagged a ColumnType
t) Get Value -> (Value -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get a) -> (a -> Get a) -> Either String a -> Get a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> Get a)
-> (Value -> Either String a) -> Value -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either String a
forall a. Cql a => Value -> Either String a
fromCql
typecheck :: [ColumnType] -> [ColumnType] -> [ColumnType]
typecheck :: [ColumnType] -> [ColumnType] -> [ColumnType]
typecheck [ColumnType]
rr [ColumnType]
cc = if (ColumnType -> ColumnType -> Bool)
-> [ColumnType] -> [ColumnType] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkAll ColumnType -> ColumnType -> Bool
(===) [ColumnType]
rr [ColumnType]
cc then [] else [ColumnType]
rr
where
checkAll :: (a -> b -> Bool) -> [a] -> [b] -> Bool
checkAll a -> b -> Bool
f [a]
as [b]
bs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((a -> b -> Bool) -> [a] -> [b] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> Bool
f [a]
as [b]
bs)
checkField :: (Text, ColumnType) -> (Text, ColumnType) -> Bool
checkField (Text
a, ColumnType
b) (Text
c, ColumnType
d) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c Bool -> Bool -> Bool
&& ColumnType
b ColumnType -> ColumnType -> Bool
=== ColumnType
d
ColumnType
TextColumn === :: ColumnType -> ColumnType -> Bool
=== ColumnType
VarCharColumn = Bool
True
ColumnType
VarCharColumn === ColumnType
TextColumn = Bool
True
(MaybeColumn ColumnType
a) === ColumnType
b = ColumnType
a ColumnType -> ColumnType -> Bool
=== ColumnType
b
(ListColumn ColumnType
a) === (ListColumn ColumnType
b) = ColumnType
a ColumnType -> ColumnType -> Bool
=== ColumnType
b
(SetColumn ColumnType
a) === (SetColumn ColumnType
b) = ColumnType
a ColumnType -> ColumnType -> Bool
=== ColumnType
b
(MapColumn ColumnType
a ColumnType
b) === (MapColumn ColumnType
c ColumnType
d) = ColumnType
a ColumnType -> ColumnType -> Bool
=== ColumnType
c Bool -> Bool -> Bool
&& ColumnType
b ColumnType -> ColumnType -> Bool
=== ColumnType
d
(UdtColumn Text
a [(Text, ColumnType)]
as) === (UdtColumn Text
b [(Text, ColumnType)]
bs) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b Bool -> Bool -> Bool
&& ((Text, ColumnType) -> (Text, ColumnType) -> Bool)
-> [(Text, ColumnType)] -> [(Text, ColumnType)] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkAll (Text, ColumnType) -> (Text, ColumnType) -> Bool
checkField [(Text, ColumnType)]
as [(Text, ColumnType)]
bs
(TupleColumn [ColumnType]
as) === (TupleColumn [ColumnType]
bs) = (ColumnType -> ColumnType -> Bool)
-> [ColumnType] -> [ColumnType] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkAll ColumnType -> ColumnType -> Bool
(===) [ColumnType]
as [ColumnType]
bs
ColumnType
a === ColumnType
b = ColumnType
a ColumnType -> ColumnType -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnType
b