module Database.CQL.Protocol.Types where

import Data.ByteString (ByteString)
import Data.Text (Text, pack, unpack)
import Data.Decimal
import Data.Int
import Data.IP
import Data.String
import Data.UUID (UUID)

import qualified Data.ByteString.Lazy as LB
import qualified Data.List            as List
import qualified Data.Set             as Set
import qualified Data.Map.Strict      as Map
import qualified Data.Text.Lazy       as LT

newtype Keyspace = Keyspace
    { Keyspace -> Text
unKeyspace :: Text } deriving (Keyspace -> Keyspace -> Bool
(Keyspace -> Keyspace -> Bool)
-> (Keyspace -> Keyspace -> Bool) -> Eq Keyspace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keyspace -> Keyspace -> Bool
$c/= :: Keyspace -> Keyspace -> Bool
== :: Keyspace -> Keyspace -> Bool
$c== :: Keyspace -> Keyspace -> Bool
Eq, Int -> Keyspace -> ShowS
[Keyspace] -> ShowS
Keyspace -> String
(Int -> Keyspace -> ShowS)
-> (Keyspace -> String) -> ([Keyspace] -> ShowS) -> Show Keyspace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Keyspace] -> ShowS
$cshowList :: [Keyspace] -> ShowS
show :: Keyspace -> String
$cshow :: Keyspace -> String
showsPrec :: Int -> Keyspace -> ShowS
$cshowsPrec :: Int -> Keyspace -> ShowS
Show)

newtype Table = Table
    { Table -> Text
unTable :: Text } deriving (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show)

-- | Opaque token passed to the server to continue result paging.
newtype PagingState = PagingState
    { PagingState -> ByteString
unPagingState :: LB.ByteString } deriving (PagingState -> PagingState -> Bool
(PagingState -> PagingState -> Bool)
-> (PagingState -> PagingState -> Bool) -> Eq PagingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PagingState -> PagingState -> Bool
$c/= :: PagingState -> PagingState -> Bool
== :: PagingState -> PagingState -> Bool
$c== :: PagingState -> PagingState -> Bool
Eq, Int -> PagingState -> ShowS
[PagingState] -> ShowS
PagingState -> String
(Int -> PagingState -> ShowS)
-> (PagingState -> String)
-> ([PagingState] -> ShowS)
-> Show PagingState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PagingState] -> ShowS
$cshowList :: [PagingState] -> ShowS
show :: PagingState -> String
$cshow :: PagingState -> String
showsPrec :: Int -> PagingState -> ShowS
$cshowsPrec :: Int -> PagingState -> ShowS
Show)

-- | ID representing a prepared query.
newtype QueryId k a b = QueryId
    { QueryId k a b -> ByteString
unQueryId :: ByteString } deriving (QueryId k a b -> QueryId k a b -> Bool
(QueryId k a b -> QueryId k a b -> Bool)
-> (QueryId k a b -> QueryId k a b -> Bool) -> Eq (QueryId k a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a b. QueryId k a b -> QueryId k a b -> Bool
/= :: QueryId k a b -> QueryId k a b -> Bool
$c/= :: forall k a b. QueryId k a b -> QueryId k a b -> Bool
== :: QueryId k a b -> QueryId k a b -> Bool
$c== :: forall k a b. QueryId k a b -> QueryId k a b -> Bool
Eq, Int -> QueryId k a b -> ShowS
[QueryId k a b] -> ShowS
QueryId k a b -> String
(Int -> QueryId k a b -> ShowS)
-> (QueryId k a b -> String)
-> ([QueryId k a b] -> ShowS)
-> Show (QueryId k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Int -> QueryId k a b -> ShowS
forall k a b. [QueryId k a b] -> ShowS
forall k a b. QueryId k a b -> String
showList :: [QueryId k a b] -> ShowS
$cshowList :: forall k a b. [QueryId k a b] -> ShowS
show :: QueryId k a b -> String
$cshow :: forall k a b. QueryId k a b -> String
showsPrec :: Int -> QueryId k a b -> ShowS
$cshowsPrec :: forall k a b. Int -> QueryId k a b -> ShowS
Show)

newtype QueryString k a b = QueryString
    { QueryString k a b -> Text
unQueryString :: LT.Text } deriving (QueryString k a b -> QueryString k a b -> Bool
(QueryString k a b -> QueryString k a b -> Bool)
-> (QueryString k a b -> QueryString k a b -> Bool)
-> Eq (QueryString k a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a b. QueryString k a b -> QueryString k a b -> Bool
/= :: QueryString k a b -> QueryString k a b -> Bool
$c/= :: forall k a b. QueryString k a b -> QueryString k a b -> Bool
== :: QueryString k a b -> QueryString k a b -> Bool
$c== :: forall k a b. QueryString k a b -> QueryString k a b -> Bool
Eq, Int -> QueryString k a b -> ShowS
[QueryString k a b] -> ShowS
QueryString k a b -> String
(Int -> QueryString k a b -> ShowS)
-> (QueryString k a b -> String)
-> ([QueryString k a b] -> ShowS)
-> Show (QueryString k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Int -> QueryString k a b -> ShowS
forall k a b. [QueryString k a b] -> ShowS
forall k a b. QueryString k a b -> String
showList :: [QueryString k a b] -> ShowS
$cshowList :: forall k a b. [QueryString k a b] -> ShowS
show :: QueryString k a b -> String
$cshow :: forall k a b. QueryString k a b -> String
showsPrec :: Int -> QueryString k a b -> ShowS
$cshowsPrec :: forall k a b. Int -> QueryString k a b -> ShowS
Show)

instance IsString (QueryString k a b) where
    fromString :: String -> QueryString k a b
fromString = Text -> QueryString k a b
forall k a b. Text -> QueryString k a b
QueryString (Text -> QueryString k a b)
-> (String -> Text) -> String -> QueryString k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack

-- | CQL binary protocol version.
data Version
    = V3 -- ^ version 3
    | V4 -- ^ version 4
    deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

-- | The CQL version (not the binary protocol version).
data CqlVersion
    = Cqlv300
    | CqlVersion !Text
    deriving (CqlVersion -> CqlVersion -> Bool
(CqlVersion -> CqlVersion -> Bool)
-> (CqlVersion -> CqlVersion -> Bool) -> Eq CqlVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CqlVersion -> CqlVersion -> Bool
$c/= :: CqlVersion -> CqlVersion -> Bool
== :: CqlVersion -> CqlVersion -> Bool
$c== :: CqlVersion -> CqlVersion -> Bool
Eq, Int -> CqlVersion -> ShowS
[CqlVersion] -> ShowS
CqlVersion -> String
(Int -> CqlVersion -> ShowS)
-> (CqlVersion -> String)
-> ([CqlVersion] -> ShowS)
-> Show CqlVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CqlVersion] -> ShowS
$cshowList :: [CqlVersion] -> ShowS
show :: CqlVersion -> String
$cshow :: CqlVersion -> String
showsPrec :: Int -> CqlVersion -> ShowS
$cshowsPrec :: Int -> CqlVersion -> ShowS
Show)

data CompressionAlgorithm
    = Snappy
    | LZ4
    | None
    deriving (CompressionAlgorithm -> CompressionAlgorithm -> Bool
(CompressionAlgorithm -> CompressionAlgorithm -> Bool)
-> (CompressionAlgorithm -> CompressionAlgorithm -> Bool)
-> Eq CompressionAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionAlgorithm -> CompressionAlgorithm -> Bool
$c/= :: CompressionAlgorithm -> CompressionAlgorithm -> Bool
== :: CompressionAlgorithm -> CompressionAlgorithm -> Bool
$c== :: CompressionAlgorithm -> CompressionAlgorithm -> Bool
Eq, Int -> CompressionAlgorithm -> ShowS
[CompressionAlgorithm] -> ShowS
CompressionAlgorithm -> String
(Int -> CompressionAlgorithm -> ShowS)
-> (CompressionAlgorithm -> String)
-> ([CompressionAlgorithm] -> ShowS)
-> Show CompressionAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionAlgorithm] -> ShowS
$cshowList :: [CompressionAlgorithm] -> ShowS
show :: CompressionAlgorithm -> String
$cshow :: CompressionAlgorithm -> String
showsPrec :: Int -> CompressionAlgorithm -> ShowS
$cshowsPrec :: Int -> CompressionAlgorithm -> ShowS
Show)

data Compression = Compression
    { Compression -> CompressionAlgorithm
algorithm :: !CompressionAlgorithm
    , Compression -> ByteString -> Maybe ByteString
shrink    :: LB.ByteString -> Maybe LB.ByteString
    , Compression -> ByteString -> Maybe ByteString
expand    :: LB.ByteString -> Maybe LB.ByteString
    }

instance Show Compression where
    show :: Compression -> String
show = CompressionAlgorithm -> String
forall a. Show a => a -> String
show (CompressionAlgorithm -> String)
-> (Compression -> CompressionAlgorithm) -> Compression -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression -> CompressionAlgorithm
algorithm

noCompression :: Compression
noCompression :: Compression
noCompression = CompressionAlgorithm
-> (ByteString -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Compression
Compression CompressionAlgorithm
None ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just

-- | Consistency level.
--
-- See: <https://docs.datastax.com/en/cassandra/latest/cassandra/dml/dmlConfigConsistency.html Consistency>
data Consistency
    = Any
    | One
    | LocalOne
    | Two
    | Three
    | Quorum
    | LocalQuorum
    | All
    | EachQuorum  -- ^ Only for write queries.
    | Serial      -- ^ Only for read queries.
    | LocalSerial -- ^ Only for read queries.
    deriving (Consistency -> Consistency -> Bool
(Consistency -> Consistency -> Bool)
-> (Consistency -> Consistency -> Bool) -> Eq Consistency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Consistency -> Consistency -> Bool
$c/= :: Consistency -> Consistency -> Bool
== :: Consistency -> Consistency -> Bool
$c== :: Consistency -> Consistency -> Bool
Eq, Int -> Consistency -> ShowS
[Consistency] -> ShowS
Consistency -> String
(Int -> Consistency -> ShowS)
-> (Consistency -> String)
-> ([Consistency] -> ShowS)
-> Show Consistency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Consistency] -> ShowS
$cshowList :: [Consistency] -> ShowS
show :: Consistency -> String
$cshow :: Consistency -> String
showsPrec :: Int -> Consistency -> ShowS
$cshowsPrec :: Int -> Consistency -> ShowS
Show)

-- | An opcode is a tag to distinguish protocol frame bodies.
data OpCode
    = OcError
    | OcStartup
    | OcReady
    | OcAuthenticate
    | OcOptions
    | OcSupported
    | OcQuery
    | OcResult
    | OcPrepare
    | OcExecute
    | OcRegister
    | OcEvent
    | OcBatch
    | OcAuthChallenge
    | OcAuthResponse
    | OcAuthSuccess
    deriving (OpCode -> OpCode -> Bool
(OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> Bool) -> Eq OpCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCode -> OpCode -> Bool
$c/= :: OpCode -> OpCode -> Bool
== :: OpCode -> OpCode -> Bool
$c== :: OpCode -> OpCode -> Bool
Eq, Int -> OpCode -> ShowS
[OpCode] -> ShowS
OpCode -> String
(Int -> OpCode -> ShowS)
-> (OpCode -> String) -> ([OpCode] -> ShowS) -> Show OpCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCode] -> ShowS
$cshowList :: [OpCode] -> ShowS
show :: OpCode -> String
$cshow :: OpCode -> String
showsPrec :: Int -> OpCode -> ShowS
$cshowsPrec :: Int -> OpCode -> ShowS
Show)

-- | The type of a single CQL column.
data ColumnType
    = CustomColumn !Text
    | AsciiColumn
    | BigIntColumn
    | BlobColumn
    | BooleanColumn
    | CounterColumn
    | DecimalColumn
    | DoubleColumn
    | FloatColumn
    | IntColumn
    | TextColumn
    | TimestampColumn
    | UuidColumn
    | VarCharColumn
    | VarIntColumn
    | TimeUuidColumn
    | InetColumn
    | MaybeColumn !ColumnType
    | ListColumn  !ColumnType
    | SetColumn   !ColumnType
    | MapColumn   !ColumnType !ColumnType
    | TupleColumn [ColumnType]
    | UdtColumn   !Text [(Text, ColumnType)]
    | DateColumn
    | TimeColumn
    | SmallIntColumn
    | TinyIntColumn
    deriving (ColumnType -> ColumnType -> Bool
(ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool) -> Eq ColumnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnType -> ColumnType -> Bool
$c/= :: ColumnType -> ColumnType -> Bool
== :: ColumnType -> ColumnType -> Bool
$c== :: ColumnType -> ColumnType -> Bool
Eq)

instance Show ColumnType where
    show :: ColumnType -> String
show (CustomColumn Text
a)  = Text -> String
unpack Text
a
    show ColumnType
AsciiColumn       = String
"ascii"
    show ColumnType
BigIntColumn      = String
"bigint"
    show ColumnType
BlobColumn        = String
"blob"
    show ColumnType
BooleanColumn     = String
"boolean"
    show ColumnType
CounterColumn     = String
"counter"
    show ColumnType
DecimalColumn     = String
"decimal"
    show ColumnType
DoubleColumn      = String
"double"
    show ColumnType
FloatColumn       = String
"float"
    show ColumnType
IntColumn         = String
"int"
    show ColumnType
TextColumn        = String
"text"
    show ColumnType
TimestampColumn   = String
"timestamp"
    show ColumnType
UuidColumn        = String
"uuid"
    show ColumnType
VarCharColumn     = String
"varchar"
    show ColumnType
VarIntColumn      = String
"varint"
    show ColumnType
TimeUuidColumn    = String
"timeuuid"
    show ColumnType
InetColumn        = String
"inet"
    show ColumnType
DateColumn        = String
"date"
    show ColumnType
TimeColumn        = String
"time"
    show ColumnType
SmallIntColumn    = String
"smallint"
    show ColumnType
TinyIntColumn     = String
"tinyint"
    show (MaybeColumn ColumnType
a)   = ColumnType -> String
forall a. Show a => a -> String
show ColumnType
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?"
    show (ListColumn ColumnType
a)    = String -> ShowS
showString String
"list<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ShowS
forall a. Show a => a -> ShowS
shows ColumnType
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (SetColumn ColumnType
a)     = String -> ShowS
showString String
"set<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ShowS
forall a. Show a => a -> ShowS
shows ColumnType
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (MapColumn ColumnType
a ColumnType
b)   = String -> ShowS
showString String
"map<"
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ShowS
forall a. Show a => a -> ShowS
shows ColumnType
a
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", "
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType -> ShowS
forall a. Show a => a -> ShowS
shows ColumnType
b
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">"
                           ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (TupleColumn [ColumnType]
a)   = String -> ShowS
showString String
"tuple<"
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ((ColumnType -> String) -> [ColumnType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ColumnType -> String
forall a. Show a => a -> String
show [ColumnType]
a))
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">"
                           ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (UdtColumn Text
t [(Text, ColumnType)]
f)   = String -> ShowS
showString (Text -> String
unpack Text
t)
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"<"
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " (((Text, ColumnType) -> String) -> [(Text, ColumnType)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text, ColumnType) -> String
forall a. Show a => a -> String
show [(Text, ColumnType)]
f))
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">"
                           ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""

newtype Ascii    = Ascii    { Ascii -> Text
fromAscii    :: Text          } deriving (Ascii -> Ascii -> Bool
(Ascii -> Ascii -> Bool) -> (Ascii -> Ascii -> Bool) -> Eq Ascii
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ascii -> Ascii -> Bool
$c/= :: Ascii -> Ascii -> Bool
== :: Ascii -> Ascii -> Bool
$c== :: Ascii -> Ascii -> Bool
Eq, Eq Ascii
Eq Ascii
-> (Ascii -> Ascii -> Ordering)
-> (Ascii -> Ascii -> Bool)
-> (Ascii -> Ascii -> Bool)
-> (Ascii -> Ascii -> Bool)
-> (Ascii -> Ascii -> Bool)
-> (Ascii -> Ascii -> Ascii)
-> (Ascii -> Ascii -> Ascii)
-> Ord Ascii
Ascii -> Ascii -> Bool
Ascii -> Ascii -> Ordering
Ascii -> Ascii -> Ascii
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ascii -> Ascii -> Ascii
$cmin :: Ascii -> Ascii -> Ascii
max :: Ascii -> Ascii -> Ascii
$cmax :: Ascii -> Ascii -> Ascii
>= :: Ascii -> Ascii -> Bool
$c>= :: Ascii -> Ascii -> Bool
> :: Ascii -> Ascii -> Bool
$c> :: Ascii -> Ascii -> Bool
<= :: Ascii -> Ascii -> Bool
$c<= :: Ascii -> Ascii -> Bool
< :: Ascii -> Ascii -> Bool
$c< :: Ascii -> Ascii -> Bool
compare :: Ascii -> Ascii -> Ordering
$ccompare :: Ascii -> Ascii -> Ordering
$cp1Ord :: Eq Ascii
Ord, Int -> Ascii -> ShowS
[Ascii] -> ShowS
Ascii -> String
(Int -> Ascii -> ShowS)
-> (Ascii -> String) -> ([Ascii] -> ShowS) -> Show Ascii
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ascii] -> ShowS
$cshowList :: [Ascii] -> ShowS
show :: Ascii -> String
$cshow :: Ascii -> String
showsPrec :: Int -> Ascii -> ShowS
$cshowsPrec :: Int -> Ascii -> ShowS
Show)
newtype Blob     = Blob     { Blob -> ByteString
fromBlob     :: LB.ByteString } deriving (Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c== :: Blob -> Blob -> Bool
Eq, Eq Blob
Eq Blob
-> (Blob -> Blob -> Ordering)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Blob)
-> (Blob -> Blob -> Blob)
-> Ord Blob
Blob -> Blob -> Bool
Blob -> Blob -> Ordering
Blob -> Blob -> Blob
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Blob -> Blob -> Blob
$cmin :: Blob -> Blob -> Blob
max :: Blob -> Blob -> Blob
$cmax :: Blob -> Blob -> Blob
>= :: Blob -> Blob -> Bool
$c>= :: Blob -> Blob -> Bool
> :: Blob -> Blob -> Bool
$c> :: Blob -> Blob -> Bool
<= :: Blob -> Blob -> Bool
$c<= :: Blob -> Blob -> Bool
< :: Blob -> Blob -> Bool
$c< :: Blob -> Blob -> Bool
compare :: Blob -> Blob -> Ordering
$ccompare :: Blob -> Blob -> Ordering
$cp1Ord :: Eq Blob
Ord, Int -> Blob -> ShowS
[Blob] -> ShowS
Blob -> String
(Int -> Blob -> ShowS)
-> (Blob -> String) -> ([Blob] -> ShowS) -> Show Blob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Blob] -> ShowS
$cshowList :: [Blob] -> ShowS
show :: Blob -> String
$cshow :: Blob -> String
showsPrec :: Int -> Blob -> ShowS
$cshowsPrec :: Int -> Blob -> ShowS
Show)
newtype Counter  = Counter  { Counter -> Int64
fromCounter  :: Int64         } deriving (Counter -> Counter -> Bool
(Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool) -> Eq Counter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c== :: Counter -> Counter -> Bool
Eq, Eq Counter
Eq Counter
-> (Counter -> Counter -> Ordering)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> Ord Counter
Counter -> Counter -> Bool
Counter -> Counter -> Ordering
Counter -> Counter -> Counter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Counter -> Counter -> Counter
$cmin :: Counter -> Counter -> Counter
max :: Counter -> Counter -> Counter
$cmax :: Counter -> Counter -> Counter
>= :: Counter -> Counter -> Bool
$c>= :: Counter -> Counter -> Bool
> :: Counter -> Counter -> Bool
$c> :: Counter -> Counter -> Bool
<= :: Counter -> Counter -> Bool
$c<= :: Counter -> Counter -> Bool
< :: Counter -> Counter -> Bool
$c< :: Counter -> Counter -> Bool
compare :: Counter -> Counter -> Ordering
$ccompare :: Counter -> Counter -> Ordering
$cp1Ord :: Eq Counter
Ord, Int -> Counter -> ShowS
[Counter] -> ShowS
Counter -> String
(Int -> Counter -> ShowS)
-> (Counter -> String) -> ([Counter] -> ShowS) -> Show Counter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Counter] -> ShowS
$cshowList :: [Counter] -> ShowS
show :: Counter -> String
$cshow :: Counter -> String
showsPrec :: Int -> Counter -> ShowS
$cshowsPrec :: Int -> Counter -> ShowS
Show)
newtype TimeUuid = TimeUuid { TimeUuid -> UUID
fromTimeUuid :: UUID          } deriving (TimeUuid -> TimeUuid -> Bool
(TimeUuid -> TimeUuid -> Bool)
-> (TimeUuid -> TimeUuid -> Bool) -> Eq TimeUuid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeUuid -> TimeUuid -> Bool
$c/= :: TimeUuid -> TimeUuid -> Bool
== :: TimeUuid -> TimeUuid -> Bool
$c== :: TimeUuid -> TimeUuid -> Bool
Eq, Eq TimeUuid
Eq TimeUuid
-> (TimeUuid -> TimeUuid -> Ordering)
-> (TimeUuid -> TimeUuid -> Bool)
-> (TimeUuid -> TimeUuid -> Bool)
-> (TimeUuid -> TimeUuid -> Bool)
-> (TimeUuid -> TimeUuid -> Bool)
-> (TimeUuid -> TimeUuid -> TimeUuid)
-> (TimeUuid -> TimeUuid -> TimeUuid)
-> Ord TimeUuid
TimeUuid -> TimeUuid -> Bool
TimeUuid -> TimeUuid -> Ordering
TimeUuid -> TimeUuid -> TimeUuid
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeUuid -> TimeUuid -> TimeUuid
$cmin :: TimeUuid -> TimeUuid -> TimeUuid
max :: TimeUuid -> TimeUuid -> TimeUuid
$cmax :: TimeUuid -> TimeUuid -> TimeUuid
>= :: TimeUuid -> TimeUuid -> Bool
$c>= :: TimeUuid -> TimeUuid -> Bool
> :: TimeUuid -> TimeUuid -> Bool
$c> :: TimeUuid -> TimeUuid -> Bool
<= :: TimeUuid -> TimeUuid -> Bool
$c<= :: TimeUuid -> TimeUuid -> Bool
< :: TimeUuid -> TimeUuid -> Bool
$c< :: TimeUuid -> TimeUuid -> Bool
compare :: TimeUuid -> TimeUuid -> Ordering
$ccompare :: TimeUuid -> TimeUuid -> Ordering
$cp1Ord :: Eq TimeUuid
Ord, Int -> TimeUuid -> ShowS
[TimeUuid] -> ShowS
TimeUuid -> String
(Int -> TimeUuid -> ShowS)
-> (TimeUuid -> String) -> ([TimeUuid] -> ShowS) -> Show TimeUuid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeUuid] -> ShowS
$cshowList :: [TimeUuid] -> ShowS
show :: TimeUuid -> String
$cshow :: TimeUuid -> String
showsPrec :: Int -> TimeUuid -> ShowS
$cshowsPrec :: Int -> TimeUuid -> ShowS
Show)
newtype Set a    = Set      { Set a -> [a]
fromSet      :: [a]           } deriving Int -> Set a -> ShowS
[Set a] -> ShowS
Set a -> String
(Int -> Set a -> ShowS)
-> (Set a -> String) -> ([Set a] -> ShowS) -> Show (Set a)
forall a. Show a => Int -> Set a -> ShowS
forall a. Show a => [Set a] -> ShowS
forall a. Show a => Set a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Set a] -> ShowS
$cshowList :: forall a. Show a => [Set a] -> ShowS
show :: Set a -> String
$cshow :: forall a. Show a => Set a -> String
showsPrec :: Int -> Set a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Set a -> ShowS
Show
newtype Map a b  = Map      { Map a b -> [(a, b)]
fromMap      :: [(a, b)]      } deriving Int -> Map a b -> ShowS
[Map a b] -> ShowS
Map a b -> String
(Int -> Map a b -> ShowS)
-> (Map a b -> String) -> ([Map a b] -> ShowS) -> Show (Map a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Map a b -> ShowS
forall a b. (Show a, Show b) => [Map a b] -> ShowS
forall a b. (Show a, Show b) => Map a b -> String
showList :: [Map a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Map a b] -> ShowS
show :: Map a b -> String
$cshow :: forall a b. (Show a, Show b) => Map a b -> String
showsPrec :: Int -> Map a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Map a b -> ShowS
Show

instance IsString Ascii where
    fromString :: String -> Ascii
fromString = Text -> Ascii
Ascii (Text -> Ascii) -> (String -> Text) -> String -> Ascii
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance (Eq a, Ord a) => Eq (Set a) where
    Set a
a == :: Set a -> Set a -> Bool
== Set a
b = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (Set a -> [a]
forall a. Set a -> [a]
fromSet Set a
a) Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (Set a -> [a]
forall a. Set a -> [a]
fromSet Set a
b)

instance (Eq k, Eq v, Ord k) => Eq (Map k v) where
    Map k v
a == :: Map k v -> Map k v -> Bool
== Map k v
b = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Map k v -> [(k, v)]
forall a b. Map a b -> [(a, b)]
fromMap Map k v
a) Map k v -> Map k v -> Bool
forall a. Eq a => a -> a -> Bool
== [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Map k v -> [(k, v)]
forall a b. Map a b -> [(a, b)]
fromMap Map k v
b)

-- | A CQL value. The various constructors correspond to CQL data-types for
-- individual columns in Cassandra.
data Value
    = CqlCustom    !LB.ByteString
    | CqlBoolean   !Bool
    | CqlInt       !Int32
    | CqlBigInt    !Int64
    | CqlVarInt    !Integer
    | CqlFloat     !Float
    | CqlDecimal   !Decimal
    | CqlDouble    !Double
    | CqlText      !Text
    | CqlInet      !IP
    | CqlUuid      !UUID
    | CqlTimestamp !Int64
    | CqlAscii     !Text
    | CqlBlob      !LB.ByteString
    | CqlCounter   !Int64
    | CqlTimeUuid  !UUID
    | CqlMaybe     (Maybe Value)
    | CqlList      [Value]
    | CqlSet       [Value]
    | CqlMap       [(Value, Value)]
    | CqlTuple     [Value]
    | CqlUdt       [(Text, Value)]
    | CqlDate      !Int32
    | CqlTime      !Int64
    | CqlSmallInt  !Int16
    | CqlTinyInt   !Int8
    deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

-- | Tag some value with a phantom type.
newtype Tagged a b = Tagged { Tagged a b -> b
untag :: b }

retag :: Tagged a c -> Tagged b c
retag :: Tagged a c -> Tagged b c
retag = c -> Tagged b c
forall a b. b -> Tagged a b
Tagged (c -> Tagged b c) -> (Tagged a c -> c) -> Tagged a c -> Tagged b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged a c -> c
forall a b. Tagged a b -> b
untag

-- | Type tag for read queries, i.e. 'QueryString R a b'.
data R
-- | Type tag for write queries, i.e. 'QueryString W a b'.
data W
-- | Type tag for schema queries, i.e. 'QueryString S a b'.
data S