module ClickHaskell.Statements where
import ClickHaskell.Primitive
import GHC.TypeLits
import Data.Kind (Type)
import Data.ByteString.Builder (Builder, byteString, word16HexFixed)
import Data.Int
import Data.ByteString as BS (ByteString)
import Data.Word
import Data.ByteString.Char8 as BS8 (concatMap, singleton, length, pack, replicate)
import Data.Bits (Bits(..))
import Data.Coerce (coerce)
import GHC.List (uncons)
import Data.Proxy (Proxy(..))
import Data.WideWord (Int128 (..), Word128(..))
type family GetTableName table :: Symbol
type instance (GetTableName (Table name columns)) = name
type instance (GetTableName (View name columns params)) = name
type family GetColumns table :: [Type]
type instance (GetColumns (Table name columns)) = columns
type instance GetColumns (View name columns params) = columns
tableName :: forall table . KnownSymbol (GetTableName table) => Builder
tableName :: forall table. KnownSymbol (GetTableName table) => Builder
tableName = (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (String -> StrictByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack) (Proxy (GetTableName table) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (GetTableName table) -> String)
-> Proxy (GetTableName table) -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(GetTableName table))
class KnownSymbol (GetTableName table) => IsTable table
data Table (name :: Symbol) (columns :: [Type])
instance KnownSymbol name => IsTable (Table name columns) where
class KnownSymbol (GetTableName view) => IsView view
data View (name :: Symbol) (columns :: [Type]) (parameters :: [Type])
instance KnownSymbol name => IsView (View name columns parameters)
type family KnownParameter param
where
KnownParameter (Parameter name parType) = (KnownSymbol name, IsChType parType, ToQueryPart parType)
data Parameter (name :: Symbol) (chType :: Type) = MkParamater chType
data Parameters parameters where
NoParameters :: Parameters '[]
AddParameter
:: KnownParameter (Parameter name chType)
=> Parameter name chType
-> Parameters parameters
-> Parameters (Parameter name chType ': parameters)
viewParameters :: (Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters :: forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters passedParameters
interpreter = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters passedParameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters (Parameters '[] -> Parameters passedParameters
interpreter Parameters '[]
NoParameters) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
renderParameters :: Parameters params -> Builder
renderParameters :: forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters params
NoParameters = Builder
""
renderParameters (AddParameter Parameter name chType
param Parameters parameters
NoParameters) = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param
renderParameters (AddParameter Parameter name chType
param Parameters parameters
moreParams) = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters parameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters parameters
moreParams
parameter
:: KnownParameter (Parameter name t)
=> t -> Parameters params -> Parameters (Parameter name t ': params)
parameter :: forall (name :: Symbol) t (params :: [*]).
KnownParameter (Parameter name t) =>
t -> Parameters params -> Parameters (Parameter name t : params)
parameter t
val = Parameter name t
-> Parameters params -> Parameters (Parameter name t : params)
forall (name :: Symbol) chType (parameters :: [*]).
KnownParameter (Parameter name chType) =>
Parameter name chType
-> Parameters parameters
-> Parameters (Parameter name chType : parameters)
AddParameter (t -> Parameter name t
forall (name :: Symbol) chType. chType -> Parameter name chType
MkParamater t
val)
renderParameter :: forall name chType . KnownParameter (Parameter name chType) => Parameter name chType -> Builder
renderParameter :: forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter (MkParamater chType
chType) = (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Proxy name -> StrictByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Proxy name -> String) -> Proxy name -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @name) Proxy name
forall {k} (t :: k). Proxy t
Proxy Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType
class ToQueryPart chType where toQueryPart :: chType -> Builder
instance ToQueryPart Int8 where toQueryPart :: Int8 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int8 -> StrictByteString) -> Int8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Int8 -> String) -> Int8 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> String
forall a. Show a => a -> String
show
instance ToQueryPart Int16 where toQueryPart :: Int16 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int16 -> StrictByteString) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Int16 -> String) -> Int16 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> String
forall a. Show a => a -> String
show
instance ToQueryPart Int32 where toQueryPart :: Int32 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int32 -> StrictByteString) -> Int32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Int32 -> String) -> Int32 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> String
forall a. Show a => a -> String
show
instance ToQueryPart Int64 where toQueryPart :: Int64 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int64 -> StrictByteString) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Int64 -> String) -> Int64 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show
instance ToQueryPart Int128 where toQueryPart :: Int128 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int128 -> StrictByteString) -> Int128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Int128 -> String) -> Int128 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int128 -> String
forall a. Show a => a -> String
show
instance ToQueryPart UInt8 where toQueryPart :: UInt8 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt8 -> StrictByteString) -> UInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt8 -> String) -> UInt8 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt8 -> String
forall a. Show a => a -> String
show
instance ToQueryPart UInt16 where toQueryPart :: UInt16 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt16 -> StrictByteString) -> UInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt16 -> String) -> UInt16 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt16 -> String
forall a. Show a => a -> String
show
instance ToQueryPart UInt32 where toQueryPart :: UInt32 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt32 -> StrictByteString) -> UInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt32 -> String) -> UInt32 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt32 -> String
forall a. Show a => a -> String
show
instance ToQueryPart UInt64 where toQueryPart :: UInt64 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt64 -> StrictByteString) -> UInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt64 -> String) -> UInt64 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt64 -> String
forall a. Show a => a -> String
show
instance ToQueryPart UInt128 where toQueryPart :: UInt128 -> Builder
toQueryPart UInt128
w128 = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt128 -> StrictByteString) -> UInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt128 -> String) -> UInt128 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt128 -> String
forall a. Show a => a -> String
show) UInt128
w128 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
instance ToQueryPart UInt256 where toQueryPart :: UInt256 -> Builder
toQueryPart UInt256
w256 = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt256 -> StrictByteString) -> UInt256 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt256 -> String) -> UInt256 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt256 -> String
forall a. Show a => a -> String
show) UInt256
w256 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
instance ToQueryPart chType => ToQueryPart (Nullable chType)
where
toQueryPart :: Nullable chType -> Builder
toQueryPart = Builder -> (chType -> Builder) -> Nullable chType -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"null" chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart
instance ToQueryPart chType => ToQueryPart (LowCardinality chType)
where
toQueryPart :: LowCardinality chType -> Builder
toQueryPart (MkLowCardinality chType
chType) = chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType
instance ToQueryPart UUID where
toQueryPart :: UUID -> Builder
toQueryPart (MkUUID (Word128 UInt64
hi UInt64
lo)) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[Builder
"'", Int -> UInt64 -> Builder
p Int
3 UInt64
hi, Int -> UInt64 -> Builder
p Int
2 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
1 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
0 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
3 UInt64
lo, Builder
"-", Int -> UInt64 -> Builder
p Int
2 UInt64
lo, Int -> UInt64 -> Builder
p Int
1 UInt64
lo, Int -> UInt64 -> Builder
p Int
0 UInt64
lo, Builder
"'"]
where
p :: Int -> Word64 -> Builder
p :: Int -> UInt64 -> Builder
p Int
shiftN UInt64
word = UInt16 -> Builder
word16HexFixed (UInt16 -> Builder) -> UInt16 -> Builder
forall a b. (a -> b) -> a -> b
$ UInt64 -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt64
word UInt64 -> Int -> UInt64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
shiftNInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16))
instance ToQueryPart ChString where
toQueryPart :: ChString -> Builder
toQueryPart (MkChString StrictByteString
string) = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
escapeQuery StrictByteString
string Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
where
escapeQuery :: BS.ByteString -> Builder
escapeQuery :: StrictByteString -> Builder
escapeQuery = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (StrictByteString -> StrictByteString)
-> StrictByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> StrictByteString) -> StrictByteString -> StrictByteString
BS8.concatMap (\case Char
'\'' -> StrictByteString
"\\\'"; Char
'\\' -> StrictByteString
"\\\\"; Char
sym -> Char -> StrictByteString
BS8.singleton Char
sym;)
instance ToQueryPart (DateTime tz)
where
toQueryPart :: DateTime tz -> Builder
toQueryPart DateTime tz
chDateTime = let time :: StrictByteString
time = String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (DateTime tz -> String) -> DateTime tz -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt32 -> String
forall a. Show a => a -> String
show (UInt32 -> String)
-> (DateTime tz -> UInt32) -> DateTime tz -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(DateTime tz) @Word32 (DateTime tz -> StrictByteString)
-> DateTime tz -> StrictByteString
forall a b. (a -> b) -> a -> b
$ DateTime tz
chDateTime
in StrictByteString -> Builder
byteString (Int -> Char -> StrictByteString
BS8.replicate (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- StrictByteString -> Int
BS8.length StrictByteString
time) Char
'0' StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
time)
instance (IsChType chType, ToQueryPart chType) => ToQueryPart (Array chType)
where
toQueryPart :: Array chType -> Builder
toQueryPart
= (\Builder
x -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]")
(Builder -> Builder)
-> (Array chType -> Builder) -> Array chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
-> ((Builder, [Builder]) -> Builder)
-> Maybe (Builder, [Builder])
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Builder -> [Builder] -> Builder)
-> (Builder, [Builder]) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Builder
a Builder
b -> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b))) (Maybe (Builder, [Builder]) -> Builder)
-> ([chType] -> Maybe (Builder, [Builder])) -> [chType] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Maybe (Builder, [Builder])
forall a. [a] -> Maybe (a, [a])
uncons
([Builder] -> Maybe (Builder, [Builder]))
-> ([chType] -> [Builder])
-> [chType]
-> Maybe (Builder, [Builder])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (chType -> Builder) -> [chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (forall chType. ToQueryPart chType => chType -> Builder
toQueryPart @chType)) ([chType] -> Builder)
-> (Array chType -> [chType]) -> Array chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Array chType) @[chType]