{-# LANGUAGE
AllowAmbiguousTypes
, DataKinds
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, GeneralizedNewtypeDeriving
, KindSignatures
, MultiParamTypeClasses
, OverloadedStrings
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, TypeOperators
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Expression.Type
(
cast
, astype
, inferredtype
, TypeExpression (..)
, typedef
, typetable
, typeview
, bool
, int2
, smallint
, int4
, int
, integer
, int8
, bigint
, numeric
, float4
, real
, float8
, doublePrecision
, money
, text
, char
, character
, varchar
, characterVarying
, bytea
, timestamp
, timestampWithTimeZone
, timestamptz
, date
, time
, timeWithTimeZone
, timetz
, interval
, uuid
, inet
, json
, jsonb
, vararray
, fixarray
, tsvector
, tsquery
, oid
, int4range
, int8range
, numrange
, tsrange
, tstzrange
, daterange
, record
, ColumnTypeExpression (..)
, nullable
, notNullable
, default_
, serial2
, smallserial
, serial4
, serial
, serial8
, bigserial
, PGTyped (..)
, pgtypeFrom
, NullTyped (..)
, nulltypeFrom
, ColumnTyped (..)
, columntypeFrom
, FieldTyped (..)
) where
import Control.DeepSeq
import Data.ByteString
import Data.String
import GHC.TypeLits
import qualified Data.ByteString as ByteString
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema
cast
:: TypeExpression db ty1
-> Expression grp lat with db params from ty0
-> Expression grp lat with db params from ty1
cast ty x = UnsafeExpression $ parenthesized $
renderSQL x <+> "::" <+> renderSQL ty
astype
:: TypeExpression db ty
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
astype = cast
inferredtype
:: NullTyped db ty
=> Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype = astype nulltype
newtype TypeExpression (db :: SchemasType) (ty :: NullType)
= UnsafeTypeExpression { renderTypeExpression :: ByteString }
deriving stock (GHC.Generic,Show,Eq,Ord)
deriving newtype (NFData)
instance RenderSQL (TypeExpression db ty) where
renderSQL = renderTypeExpression
typedef
:: (Has sch db schema, Has td schema ('Typedef ty))
=> QualifiedAlias sch td
-> TypeExpression db (null ty)
typedef = UnsafeTypeExpression . renderSQL
typetable
:: (Has sch db schema, Has tab schema ('Table table))
=> QualifiedAlias sch tab
-> TypeExpression db (null ('PGcomposite (TableToRow table)))
typetable = UnsafeTypeExpression . renderSQL
typeview
:: (Has sch db schema, Has vw schema ('View view))
=> QualifiedAlias sch vw
-> TypeExpression db (null ('PGcomposite view))
typeview = UnsafeTypeExpression . renderSQL
bool :: TypeExpression db (null 'PGbool)
bool = UnsafeTypeExpression "bool"
int2, smallint :: TypeExpression db (null 'PGint2)
int2 = UnsafeTypeExpression "int2"
smallint = UnsafeTypeExpression "smallint"
int4, int, integer :: TypeExpression db (null 'PGint4)
int4 = UnsafeTypeExpression "int4"
int = UnsafeTypeExpression "int"
integer = UnsafeTypeExpression "integer"
int8, bigint :: TypeExpression db (null 'PGint8)
int8 = UnsafeTypeExpression "int8"
bigint = UnsafeTypeExpression "bigint"
numeric :: TypeExpression db (null 'PGnumeric)
numeric = UnsafeTypeExpression "numeric"
float4, real :: TypeExpression db (null 'PGfloat4)
float4 = UnsafeTypeExpression "float4"
real = UnsafeTypeExpression "real"
float8, doublePrecision :: TypeExpression db (null 'PGfloat8)
float8 = UnsafeTypeExpression "float8"
doublePrecision = UnsafeTypeExpression "double precision"
money :: TypeExpression schema (null 'PGmoney)
money = UnsafeTypeExpression "money"
text :: TypeExpression db (null 'PGtext)
text = UnsafeTypeExpression "text"
char, character
:: forall n db null. (KnownNat n, 1 <= n)
=> TypeExpression db (null ('PGchar n))
char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"
character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"
varchar, characterVarying
:: forall n db null. (KnownNat n, 1 <= n)
=> TypeExpression db (null ('PGvarchar n))
varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"
characterVarying = UnsafeTypeExpression $
"character varying(" <> renderNat @n <> ")"
bytea :: TypeExpression db (null 'PGbytea)
bytea = UnsafeTypeExpression "bytea"
timestamp :: TypeExpression db (null 'PGtimestamp)
timestamp = UnsafeTypeExpression "timestamp"
timestampWithTimeZone, timestamptz :: TypeExpression db (null 'PGtimestamptz)
timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
timestamptz = UnsafeTypeExpression "timestamptz"
date :: TypeExpression db (null 'PGdate)
date = UnsafeTypeExpression "date"
time :: TypeExpression db (null 'PGtime)
time = UnsafeTypeExpression "time"
timeWithTimeZone, timetz :: TypeExpression db (null 'PGtimetz)
timeWithTimeZone = UnsafeTypeExpression "time with time zone"
timetz = UnsafeTypeExpression "timetz"
interval :: TypeExpression db (null 'PGinterval)
interval = UnsafeTypeExpression "interval"
uuid :: TypeExpression db (null 'PGuuid)
uuid = UnsafeTypeExpression "uuid"
inet :: TypeExpression db (null 'PGinet)
inet = UnsafeTypeExpression "inet"
json :: TypeExpression db (null 'PGjson)
json = UnsafeTypeExpression "json"
jsonb :: TypeExpression db (null 'PGjsonb)
jsonb = UnsafeTypeExpression "jsonb"
vararray
:: TypeExpression db pg
-> TypeExpression db (null ('PGvararray pg))
vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"
fixarray
:: forall dims db null pg. SOP.All KnownNat dims
=> TypeExpression db pg
-> TypeExpression db (null ('PGfixarray dims pg))
fixarray ty = UnsafeTypeExpression $
renderSQL ty <> renderDims @dims
where
renderDims :: forall ns. SOP.All KnownNat ns => ByteString
renderDims =
("[" <>)
. (<> "]")
. ByteString.intercalate "]["
. SOP.hcollapse
$ SOP.hcmap (SOP.Proxy @KnownNat)
(SOP.K . fromString . show . natVal)
(SOP.hpure SOP.Proxy :: SOP.NP SOP.Proxy ns)
tsvector :: TypeExpression db (null 'PGtsvector)
tsvector = UnsafeTypeExpression "tsvector"
tsquery :: TypeExpression db (null 'PGtsquery)
tsquery = UnsafeTypeExpression "tsquery"
oid :: TypeExpression db (null 'PGoid)
oid = UnsafeTypeExpression "oid"
int4range :: TypeExpression db (null ('PGrange 'PGint4))
int4range = UnsafeTypeExpression "int4range"
int8range :: TypeExpression db (null ('PGrange 'PGint8))
int8range = UnsafeTypeExpression "int8range"
numrange :: TypeExpression db (null ('PGrange 'PGnumeric))
numrange = UnsafeTypeExpression "numrange"
tsrange :: TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange = UnsafeTypeExpression "tsrange"
tstzrange :: TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange = UnsafeTypeExpression "tstzrange"
daterange :: TypeExpression db (null ('PGrange 'PGdate))
daterange = UnsafeTypeExpression "daterange"
record :: TypeExpression db (null ('PGcomposite record))
record = UnsafeTypeExpression "record"
class PGTyped db (ty :: PGType) where pgtype :: TypeExpression db (null ty)
instance PGTyped db 'PGbool where pgtype = bool
instance PGTyped db 'PGint2 where pgtype = int2
instance PGTyped db 'PGint4 where pgtype = int4
instance PGTyped db 'PGint8 where pgtype = int8
instance PGTyped db 'PGnumeric where pgtype = numeric
instance PGTyped db 'PGfloat4 where pgtype = float4
instance PGTyped db 'PGfloat8 where pgtype = float8
instance PGTyped db 'PGmoney where pgtype = money
instance PGTyped db 'PGtext where pgtype = text
instance (KnownNat n, 1 <= n)
=> PGTyped db ('PGchar n) where pgtype = char @n
instance (KnownNat n, 1 <= n)
=> PGTyped db ('PGvarchar n) where pgtype = varchar @n
instance PGTyped db 'PGbytea where pgtype = bytea
instance PGTyped db 'PGtimestamp where pgtype = timestamp
instance PGTyped db 'PGtimestamptz where pgtype = timestampWithTimeZone
instance PGTyped db 'PGdate where pgtype = date
instance PGTyped db 'PGtime where pgtype = time
instance PGTyped db 'PGtimetz where pgtype = timeWithTimeZone
instance PGTyped db 'PGinterval where pgtype = interval
instance PGTyped db 'PGuuid where pgtype = uuid
instance PGTyped db 'PGjson where pgtype = json
instance PGTyped db 'PGjsonb where pgtype = jsonb
instance PGTyped db pg => PGTyped db ('PGvararray (null pg)) where
pgtype = vararray (pgtype @db @pg)
instance (SOP.All KnownNat dims, PGTyped db pg)
=> PGTyped db ('PGfixarray dims (null pg)) where
pgtype = fixarray @dims (pgtype @db @pg)
instance PGTyped db 'PGtsvector where pgtype = tsvector
instance PGTyped db 'PGtsquery where pgtype = tsquery
instance PGTyped db 'PGoid where pgtype = oid
instance PGTyped db ('PGrange 'PGint4) where pgtype = int4range
instance PGTyped db ('PGrange 'PGint8) where pgtype = int8range
instance PGTyped db ('PGrange 'PGnumeric) where pgtype = numrange
instance PGTyped db ('PGrange 'PGtimestamp) where pgtype = tsrange
instance PGTyped db ('PGrange 'PGtimestamptz) where pgtype = tstzrange
instance PGTyped db ('PGrange 'PGdate) where pgtype = daterange
instance
( UserType db ('PGcomposite row) ~ '(sch,td)
, Has sch db schema
, Has td schema ('Typedef ('PGcomposite row))
) => PGTyped db ('PGcomposite row) where
pgtype = typedef (QualifiedAlias @sch @td)
instance
( UserType db ('PGenum labels) ~ '(sch,td)
, Has sch db schema
, Has td schema ('Typedef ('PGenum labels))
) => PGTyped db ('PGenum labels) where
pgtype = typedef (QualifiedAlias @sch @td)
pgtypeFrom
:: forall hask db null. PGTyped db (PG hask)
=> TypeExpression db (null (PG hask))
pgtypeFrom = pgtype @db @(PG hask)
class FieldTyped db ty where fieldtype :: Aliased (TypeExpression db) ty
instance (KnownSymbol alias, NullTyped db ty)
=> FieldTyped db (alias ::: ty) where
fieldtype = nulltype `As` Alias
newtype ColumnTypeExpression (db :: SchemasType) (ty :: ColumnType)
= UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
deriving stock (GHC.Generic,Show,Eq,Ord)
deriving newtype (NFData)
instance RenderSQL (ColumnTypeExpression db ty) where
renderSQL = renderColumnTypeExpression
nullable
:: TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'Null ty)
nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
notNullable
:: TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
default_
:: Expression 'Ungrouped '[] '[] db '[] '[] ty
-> ColumnTypeExpression db ('NoDef :=> ty)
-> ColumnTypeExpression db ('Def :=> ty)
default_ x ty = UnsafeColumnTypeExpression $
renderSQL ty <+> "DEFAULT" <+> renderExpression x
serial2, smallserial
:: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
serial2 = UnsafeColumnTypeExpression "serial2"
smallserial = UnsafeColumnTypeExpression "smallserial"
serial4, serial
:: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
serial4 = UnsafeColumnTypeExpression "serial4"
serial = UnsafeColumnTypeExpression "serial"
serial8, bigserial
:: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
serial8 = UnsafeColumnTypeExpression "serial8"
bigserial = UnsafeColumnTypeExpression "bigserial"
class NullTyped db (ty :: NullType) where
nulltype :: TypeExpression db ty
instance PGTyped db ty => NullTyped db (null ty) where
nulltype = pgtype @db @ty
nulltypeFrom
:: forall hask db. NullTyped db (NullPG hask)
=> TypeExpression db (NullPG hask)
nulltypeFrom = nulltype @db @(NullPG hask)
class ColumnTyped db (column :: ColumnType) where
columntype :: ColumnTypeExpression db column
instance NullTyped db ('Null ty)
=> ColumnTyped db ('NoDef :=> 'Null ty) where
columntype = nullable (nulltype @db @('Null ty))
instance NullTyped db ('NotNull ty)
=> ColumnTyped db ('NoDef :=> 'NotNull ty) where
columntype = notNullable (nulltype @db @('NotNull ty))
columntypeFrom
:: forall hask db. (ColumnTyped db ('NoDef :=> NullPG hask))
=> ColumnTypeExpression db ('NoDef :=> NullPG hask)
columntypeFrom = columntype @db @('NoDef :=> NullPG hask)