{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE InstanceSigs #-}
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 qualified Data.Text as T
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
$c== :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
/= :: 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
$cshowsPrec :: Int -> Row -> ShowS
showsPrec :: Int -> Row -> ShowS
$cshow :: Row -> String
show :: Row -> String
$cshowList :: [Row] -> ShowS
showList :: [Row] -> ShowS
Show)
fromRow :: Cql a => Int -> Row -> Either String a
fromRow :: forall a. Cql a => 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 -> [ColumnSpec] -> 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 -> [ColumnSpec] -> Get ()
tuple Version
_ [ColumnSpec]
_ = () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
store :: Version -> Putter ()
store Version
_ = Put -> Putter ()
forall a b. a -> b -> a
const (Put -> Putter ()) -> Put -> Putter ()
forall a b. (a -> b) -> a -> b
$ Putter ()
forall a. a -> PutM a
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)]
store :: Cql a => Version -> Putter (Identity a)
tuple :: Cql a => Version -> [ColumnSpec] -> Get (Identity a)
tuple :: Cql a => Version -> [ColumnSpec] -> Get (Identity a)
tuple Version
v [ColumnSpec]
cs = String -> Get (Identity a) -> Get (Identity a)
forall a. String -> Get a -> Get a
label String
"Identity" (Get (Identity a) -> Get (Identity a))
-> Get (Identity a) -> Get (Identity a)
forall a b. (a -> b) -> a -> b
$ 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 -> [ColumnSpec] -> Int -> Tagged a ColumnType -> Get a
forall a.
Cql a =>
Version -> [ColumnSpec] -> Int -> Tagged a ColumnType -> Get a
element Version
v [ColumnSpec]
cs Int
0 Tagged a ColumnType
forall a. Cql a => Tagged a ColumnType
ctype
store :: Cql a => 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 -> [ColumnSpec] -> Get Row
tuple :: Version -> [ColumnSpec] -> Get Row
tuple Version
v [ColumnSpec]
cs = [ColumnType] -> Vector Value -> Row
Row ((ColumnSpec -> ColumnType) -> [ColumnSpec] -> [ColumnType]
forall a b. (a -> b) -> [a] -> [b]
map ColumnSpec -> ColumnType
columnType [ColumnSpec]
cs) (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
<$> (ColumnSpec -> Get Value) -> [ColumnSpec] -> Get [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Version -> ColumnType -> Get Value
getValue Version
v (ColumnType -> Get Value)
-> (ColumnSpec -> ColumnType) -> ColumnSpec -> Get Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ColumnType
MaybeColumn (ColumnType -> ColumnType)
-> (ColumnSpec -> ColumnType) -> ColumnSpec -> ColumnType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnSpec -> ColumnType
columnType) [ColumnSpec]
cs
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 -> Put
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 -> [ColumnSpec] -> Int -> Tagged a ColumnType -> Get a
element :: forall a.
Cql a =>
Version -> [ColumnSpec] -> Int -> Tagged a ColumnType -> Get a
element Version
v [ColumnSpec]
cols Int
i Tagged a ColumnType
t =
let col :: ColumnSpec
col = [ColumnSpec]
cols [ColumnSpec] -> Int -> ColumnSpec
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
context :: String
context = Text -> String
T.unpack (Text
"Reading column \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnSpec -> Text
columnName ColumnSpec
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" of table \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Keyspace -> Text
unKeyspace (ColumnSpec -> Keyspace
keyspace ColumnSpec
col) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Table -> Text
unTable (ColumnSpec -> Table
table ColumnSpec
col) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
in String -> Get a -> Get a
forall a. String -> Get a -> Get a
label String
context (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ 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 a b. Get a -> (a -> Get b) -> Get b
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 a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Get a
forall a. 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