{-|
Module: Squeal.PostgreSQL.Expression
Description: type expressions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

type expressions
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , MultiParamTypeClasses
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Type
  ( -- * Type Cast
    cast
  , astype
  , inferredtype
    -- * Type Expression
  , TypeExpression (..)
  , typerow
  , typeenum
  , 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
    -- * Column Type
  , ColumnTypeExpression (..)
  , nullable
  , notNullable
  , default_
  , serial2
  , smallserial
  , serial4
  , serial
  , serial8
  , bigserial
    -- * Type Inference
  , 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

-- $setup
-- >>> import Squeal.PostgreSQL

-- When a `cast` is applied to an `Expression` of a known type, it
-- represents a run-time type conversion. The cast will succeed only if a
-- suitable type conversion operation has been defined.
--
-- | >>> printSQL $ true & cast int4
-- (TRUE :: int4)
cast
  :: TypeExpression db ty1
  -- ^ type to cast as
  -> Expression grp lat with db params from ty0
  -- ^ value to convert
  -> Expression grp lat with db params from ty1
cast :: TypeExpression db ty1
-> Expression grp lat with db params from ty0
-> Expression grp lat with db params from ty1
cast TypeExpression db ty1
ty Expression grp lat with db params from ty0
x = ByteString -> Expression grp lat with db params from ty1
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString -> Expression grp lat with db params from ty1)
-> ByteString -> Expression grp lat with db params from ty1
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
parenthesized (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  Expression grp lat with db params from ty0 -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ty0
x ByteString -> ByteString -> ByteString
<+> ByteString
"::" ByteString -> ByteString -> ByteString
<+> TypeExpression db ty1 -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db ty1
ty

-- | A safe version of `cast` which just matches a value with its type.
--
-- >>> printSQL (1 & astype int)
-- ((1 :: int4) :: int)
astype
  :: TypeExpression db ty
  -- ^ type to specify as
  -> Expression grp lat with db params from ty
  -- ^ value
  -> Expression grp lat with db params from ty
astype :: TypeExpression db ty
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
astype = TypeExpression db ty
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
forall (db :: SchemasType) (ty1 :: NullType) (grp :: Grouping)
       (lat :: FromType) (with :: FromType) (params :: [NullType])
       (from :: FromType) (ty0 :: NullType).
TypeExpression db ty1
-> Expression grp lat with db params from ty0
-> Expression grp lat with db params from ty1
cast

-- | `inferredtype` will add a type annotation to an `Expression`
-- which can be useful for fixing the storage type of a value.
--
-- >>> printSQL (inferredtype true)
-- (TRUE :: bool)
inferredtype
  :: NullTyped db ty
  => Expression lat common grp db params from ty
  -- ^ value
  -> Expression lat common grp db params from ty
inferredtype :: Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype = TypeExpression db ty
-> Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
forall (db :: SchemasType) (ty :: NullType) (grp :: Grouping)
       (lat :: FromType) (with :: FromType) (params :: [NullType])
       (from :: FromType).
TypeExpression db ty
-> Expression grp lat with db params from ty
-> Expression grp lat with db params from ty
astype TypeExpression db ty
forall (db :: SchemasType) (ty :: NullType).
NullTyped db ty =>
TypeExpression db ty
nulltype

{-----------------------------------------
type expressions
-----------------------------------------}

-- | `TypeExpression`s are used in `cast`s and
-- `Squeal.PostgreSQL.Definition.createTable` commands.
newtype TypeExpression (db :: SchemasType) (ty :: NullType)
  = UnsafeTypeExpression { TypeExpression db ty -> ByteString
renderTypeExpression :: ByteString }
  deriving stock ((forall x. TypeExpression db ty -> Rep (TypeExpression db ty) x)
-> (forall x. Rep (TypeExpression db ty) x -> TypeExpression db ty)
-> Generic (TypeExpression db ty)
forall (db :: SchemasType) (ty :: NullType) x.
Rep (TypeExpression db ty) x -> TypeExpression db ty
forall (db :: SchemasType) (ty :: NullType) x.
TypeExpression db ty -> Rep (TypeExpression db ty) x
forall x. Rep (TypeExpression db ty) x -> TypeExpression db ty
forall x. TypeExpression db ty -> Rep (TypeExpression db ty) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (db :: SchemasType) (ty :: NullType) x.
Rep (TypeExpression db ty) x -> TypeExpression db ty
$cfrom :: forall (db :: SchemasType) (ty :: NullType) x.
TypeExpression db ty -> Rep (TypeExpression db ty) x
GHC.Generic,Int -> TypeExpression db ty -> ShowS
[TypeExpression db ty] -> ShowS
TypeExpression db ty -> String
(Int -> TypeExpression db ty -> ShowS)
-> (TypeExpression db ty -> String)
-> ([TypeExpression db ty] -> ShowS)
-> Show (TypeExpression db ty)
forall (db :: SchemasType) (ty :: NullType).
Int -> TypeExpression db ty -> ShowS
forall (db :: SchemasType) (ty :: NullType).
[TypeExpression db ty] -> ShowS
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeExpression db ty] -> ShowS
$cshowList :: forall (db :: SchemasType) (ty :: NullType).
[TypeExpression db ty] -> ShowS
show :: TypeExpression db ty -> String
$cshow :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> String
showsPrec :: Int -> TypeExpression db ty -> ShowS
$cshowsPrec :: forall (db :: SchemasType) (ty :: NullType).
Int -> TypeExpression db ty -> ShowS
Show,TypeExpression db ty -> TypeExpression db ty -> Bool
(TypeExpression db ty -> TypeExpression db ty -> Bool)
-> (TypeExpression db ty -> TypeExpression db ty -> Bool)
-> Eq (TypeExpression db ty)
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c/= :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
== :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c== :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
Eq,Eq (TypeExpression db ty)
Eq (TypeExpression db ty)
-> (TypeExpression db ty -> TypeExpression db ty -> Ordering)
-> (TypeExpression db ty -> TypeExpression db ty -> Bool)
-> (TypeExpression db ty -> TypeExpression db ty -> Bool)
-> (TypeExpression db ty -> TypeExpression db ty -> Bool)
-> (TypeExpression db ty -> TypeExpression db ty -> Bool)
-> (TypeExpression db ty
    -> TypeExpression db ty -> TypeExpression db ty)
-> (TypeExpression db ty
    -> TypeExpression db ty -> TypeExpression db ty)
-> Ord (TypeExpression db ty)
TypeExpression db ty -> TypeExpression db ty -> Bool
TypeExpression db ty -> TypeExpression db ty -> Ordering
TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
forall (db :: SchemasType) (ty :: NullType).
Eq (TypeExpression db ty)
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Ordering
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
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 :: TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
$cmin :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
max :: TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
$cmax :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty
-> TypeExpression db ty -> TypeExpression db ty
>= :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c>= :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
> :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c> :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
<= :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c<= :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
< :: TypeExpression db ty -> TypeExpression db ty -> Bool
$c< :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Bool
compare :: TypeExpression db ty -> TypeExpression db ty -> Ordering
$ccompare :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> TypeExpression db ty -> Ordering
$cp1Ord :: forall (db :: SchemasType) (ty :: NullType).
Eq (TypeExpression db ty)
Ord)
  deriving newtype (TypeExpression db ty -> ()
(TypeExpression db ty -> ()) -> NFData (TypeExpression db ty)
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> ()
forall a. (a -> ()) -> NFData a
rnf :: TypeExpression db ty -> ()
$crnf :: forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> ()
NFData)
instance RenderSQL (TypeExpression db ty) where
  renderSQL :: TypeExpression db ty -> ByteString
renderSQL = TypeExpression db ty -> ByteString
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> ByteString
renderTypeExpression

-- | The composite type corresponding to a relation can be expressed
-- by its alias. A relation is either a composite type, a table or a view.
-- It subsumes `typetable` and `typeview` and partly overlaps `typedef`.
typerow
  :: ( relss ~ DbRelations db
     , Has sch relss rels
     , Has rel rels row
     )
  => QualifiedAlias sch rel
  -- ^ type alias
  -> TypeExpression db (null ('PGcomposite row))
typerow :: QualifiedAlias sch rel
-> TypeExpression db (null ('PGcomposite row))
typerow = ByteString -> TypeExpression db (null ('PGcomposite row))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGcomposite row)))
-> (QualifiedAlias sch rel -> ByteString)
-> QualifiedAlias sch rel
-> TypeExpression db (null ('PGcomposite row))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedAlias sch rel -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL

-- | An enumerated type can be expressed by its alias.
-- `typeenum` is subsumed by `typedef`.
typeenum
  :: ( enumss ~ DbEnums db
     , Has sch enumss enums
     , Has enum enums labels
     )
  => QualifiedAlias sch enum
  -- ^ type alias
  -> TypeExpression db (null ('PGenum labels))
typeenum :: QualifiedAlias sch enum
-> TypeExpression db (null ('PGenum labels))
typeenum = ByteString -> TypeExpression db (null ('PGenum labels))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGenum labels)))
-> (QualifiedAlias sch enum -> ByteString)
-> QualifiedAlias sch enum
-> TypeExpression db (null ('PGenum labels))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedAlias sch enum -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL

-- | The enum or composite type in a `Typedef` can be expressed by its alias.
typedef
  :: (Has sch db schema, Has td schema ('Typedef ty))
  => QualifiedAlias sch td
  -- ^ type alias
  -> TypeExpression db (null ty)
typedef :: QualifiedAlias sch td -> TypeExpression db (null ty)
typedef = ByteString -> TypeExpression db (null ty)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ty))
-> (QualifiedAlias sch td -> ByteString)
-> QualifiedAlias sch td
-> TypeExpression db (null ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedAlias sch td -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL

-- | The composite type corresponding to a `Table` definition can be expressed
-- by its alias. It is subsumed by `typerow`
typetable
  :: (Has sch db schema, Has tab schema ('Table table))
  => QualifiedAlias sch tab
  -- ^ table alias
  -> TypeExpression db (null ('PGcomposite (TableToRow table)))
typetable :: QualifiedAlias sch tab
-> TypeExpression db (null ('PGcomposite (TableToRow table)))
typetable = ByteString
-> TypeExpression
     db (null ('PGcomposite (ColumnsToRow (TableToColumns table))))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString
 -> TypeExpression
      db (null ('PGcomposite (ColumnsToRow (TableToColumns table)))))
-> (QualifiedAlias sch tab -> ByteString)
-> QualifiedAlias sch tab
-> TypeExpression
     db (null ('PGcomposite (ColumnsToRow (TableToColumns table))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedAlias sch tab -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL

-- | The composite type corresponding to a `View` definition can be expressed
-- by its alias. It is subsumed by `typerow`.
typeview
  :: (Has sch db schema, Has vw schema ('View view))
  => QualifiedAlias sch vw
  -- ^ view alias
  -> TypeExpression db (null ('PGcomposite view))
typeview :: QualifiedAlias sch vw
-> TypeExpression db (null ('PGcomposite view))
typeview = ByteString -> TypeExpression db (null ('PGcomposite view))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGcomposite view)))
-> (QualifiedAlias sch vw -> ByteString)
-> QualifiedAlias sch vw
-> TypeExpression db (null ('PGcomposite view))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedAlias sch vw -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL

-- | logical Boolean (true/false)
bool :: TypeExpression db (null 'PGbool)
bool :: TypeExpression db (null 'PGbool)
bool = ByteString -> TypeExpression db (null 'PGbool)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"bool"
-- | signed two-byte integer
int2, smallint :: TypeExpression db (null 'PGint2)
int2 :: TypeExpression db (null 'PGint2)
int2 = ByteString -> TypeExpression db (null 'PGint2)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int2"
smallint :: TypeExpression db (null 'PGint2)
smallint = ByteString -> TypeExpression db (null 'PGint2)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"smallint"
-- | signed four-byte integer
int4, int, integer :: TypeExpression db (null 'PGint4)
int4 :: TypeExpression db (null 'PGint4)
int4 = ByteString -> TypeExpression db (null 'PGint4)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int4"
int :: TypeExpression db (null 'PGint4)
int = ByteString -> TypeExpression db (null 'PGint4)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int"
integer :: TypeExpression db (null 'PGint4)
integer = ByteString -> TypeExpression db (null 'PGint4)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"integer"
-- | signed eight-byte integer
int8, bigint :: TypeExpression db (null 'PGint8)
int8 :: TypeExpression db (null 'PGint8)
int8 = ByteString -> TypeExpression db (null 'PGint8)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int8"
bigint :: TypeExpression db (null 'PGint8)
bigint = ByteString -> TypeExpression db (null 'PGint8)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"bigint"
-- | arbitrary precision numeric type
numeric :: TypeExpression db (null 'PGnumeric)
numeric :: TypeExpression db (null 'PGnumeric)
numeric = ByteString -> TypeExpression db (null 'PGnumeric)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"numeric"
-- | single precision floating-point number (4 bytes)
float4, real :: TypeExpression db (null 'PGfloat4)
float4 :: TypeExpression db (null 'PGfloat4)
float4 = ByteString -> TypeExpression db (null 'PGfloat4)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"float4"
real :: TypeExpression db (null 'PGfloat4)
real = ByteString -> TypeExpression db (null 'PGfloat4)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"real"
-- | double precision floating-point number (8 bytes)
float8, doublePrecision :: TypeExpression db (null 'PGfloat8)
float8 :: TypeExpression db (null 'PGfloat8)
float8 = ByteString -> TypeExpression db (null 'PGfloat8)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"float8"
doublePrecision :: TypeExpression db (null 'PGfloat8)
doublePrecision = ByteString -> TypeExpression db (null 'PGfloat8)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"double precision"
-- | currency amount
money :: TypeExpression schema (null 'PGmoney)
money :: TypeExpression schema (null 'PGmoney)
money = ByteString -> TypeExpression schema (null 'PGmoney)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"money"
-- | variable-length character string
text :: TypeExpression db (null 'PGtext)
text :: TypeExpression db (null 'PGtext)
text = ByteString -> TypeExpression db (null 'PGtext)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"text"
-- | fixed-length character string
char, character
  :: forall n db null. (KnownNat n, 1 <= n)
  => TypeExpression db (null ('PGchar n))
char :: TypeExpression db (null ('PGchar n))
char = ByteString -> TypeExpression db (null ('PGchar n))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGchar n)))
-> ByteString -> TypeExpression db (null ('PGchar n))
forall a b. (a -> b) -> a -> b
$ ByteString
"char(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> KnownNat n => ByteString
forall (n :: Nat). KnownNat n => ByteString
renderNat @n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
character :: TypeExpression db (null ('PGchar n))
character = ByteString -> TypeExpression db (null ('PGchar n))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGchar n)))
-> ByteString -> TypeExpression db (null ('PGchar n))
forall a b. (a -> b) -> a -> b
$  ByteString
"character(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> KnownNat n => ByteString
forall (n :: Nat). KnownNat n => ByteString
renderNat @n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
-- | variable-length character string
varchar, characterVarying
  :: forall n db null. (KnownNat n, 1 <= n)
  => TypeExpression db (null ('PGvarchar n))
varchar :: TypeExpression db (null ('PGvarchar n))
varchar = ByteString -> TypeExpression db (null ('PGvarchar n))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGvarchar n)))
-> ByteString -> TypeExpression db (null ('PGvarchar n))
forall a b. (a -> b) -> a -> b
$ ByteString
"varchar(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> KnownNat n => ByteString
forall (n :: Nat). KnownNat n => ByteString
renderNat @n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
characterVarying :: TypeExpression db (null ('PGvarchar n))
characterVarying = ByteString -> TypeExpression db (null ('PGvarchar n))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGvarchar n)))
-> ByteString -> TypeExpression db (null ('PGvarchar n))
forall a b. (a -> b) -> a -> b
$
  ByteString
"character varying(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> KnownNat n => ByteString
forall (n :: Nat). KnownNat n => ByteString
renderNat @n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
-- | binary data ("byte array")
bytea :: TypeExpression db (null 'PGbytea)
bytea :: TypeExpression db (null 'PGbytea)
bytea = ByteString -> TypeExpression db (null 'PGbytea)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"bytea"
-- | date and time (no time zone)
timestamp :: TypeExpression db (null 'PGtimestamp)
timestamp :: TypeExpression db (null 'PGtimestamp)
timestamp = ByteString -> TypeExpression db (null 'PGtimestamp)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"timestamp"
-- | date and time, including time zone
timestampWithTimeZone, timestamptz :: TypeExpression db (null 'PGtimestamptz)
timestampWithTimeZone :: TypeExpression db (null 'PGtimestamptz)
timestampWithTimeZone = ByteString -> TypeExpression db (null 'PGtimestamptz)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"timestamp with time zone"
timestamptz :: TypeExpression db (null 'PGtimestamptz)
timestamptz = ByteString -> TypeExpression db (null 'PGtimestamptz)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"timestamptz"
-- | calendar date (year, month, day)
date :: TypeExpression db (null 'PGdate)
date :: TypeExpression db (null 'PGdate)
date = ByteString -> TypeExpression db (null 'PGdate)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"date"
-- | time of day (no time zone)
time :: TypeExpression db (null 'PGtime)
time :: TypeExpression db (null 'PGtime)
time = ByteString -> TypeExpression db (null 'PGtime)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"time"
-- | time of day, including time zone
timeWithTimeZone, timetz :: TypeExpression db (null 'PGtimetz)
timeWithTimeZone :: TypeExpression db (null 'PGtimetz)
timeWithTimeZone = ByteString -> TypeExpression db (null 'PGtimetz)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"time with time zone"
timetz :: TypeExpression db (null 'PGtimetz)
timetz = ByteString -> TypeExpression db (null 'PGtimetz)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"timetz"
-- | time span
interval :: TypeExpression db (null 'PGinterval)
interval :: TypeExpression db (null 'PGinterval)
interval = ByteString -> TypeExpression db (null 'PGinterval)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"interval"
-- | universally unique identifier
uuid :: TypeExpression db (null 'PGuuid)
uuid :: TypeExpression db (null 'PGuuid)
uuid = ByteString -> TypeExpression db (null 'PGuuid)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"uuid"
-- | IPv4 or IPv6 host address
inet :: TypeExpression db (null 'PGinet)
inet :: TypeExpression db (null 'PGinet)
inet = ByteString -> TypeExpression db (null 'PGinet)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"inet"
-- | textual JSON data
json :: TypeExpression db (null 'PGjson)
json :: TypeExpression db (null 'PGjson)
json = ByteString -> TypeExpression db (null 'PGjson)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"json"
-- | binary JSON data, decomposed
jsonb :: TypeExpression db (null 'PGjsonb)
jsonb :: TypeExpression db (null 'PGjsonb)
jsonb = ByteString -> TypeExpression db (null 'PGjsonb)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"jsonb"
-- | variable length array
vararray
  :: TypeExpression db pg
  -> TypeExpression db (null ('PGvararray pg))
vararray :: TypeExpression db pg -> TypeExpression db (null ('PGvararray pg))
vararray TypeExpression db pg
ty = ByteString -> TypeExpression db (null ('PGvararray pg))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGvararray pg)))
-> ByteString -> TypeExpression db (null ('PGvararray pg))
forall a b. (a -> b) -> a -> b
$ TypeExpression db pg -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db pg
ty ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"[]"
-- | fixed length array
--
-- >>> renderSQL (fixarray @'[2] json)
-- "json[2]"
fixarray
  :: forall dims db null pg. SOP.All KnownNat dims
  => TypeExpression db pg
  -> TypeExpression db (null ('PGfixarray dims pg))
fixarray :: TypeExpression db pg
-> TypeExpression db (null ('PGfixarray dims pg))
fixarray TypeExpression db pg
ty = ByteString -> TypeExpression db (null ('PGfixarray dims pg))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression (ByteString -> TypeExpression db (null ('PGfixarray dims pg)))
-> ByteString -> TypeExpression db (null ('PGfixarray dims pg))
forall a b. (a -> b) -> a -> b
$
  TypeExpression db pg -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db pg
ty ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> All KnownNat dims => ByteString
forall (ns :: [Nat]). All KnownNat ns => ByteString
renderDims @dims
  where
    renderDims :: forall ns. SOP.All KnownNat ns => ByteString
    renderDims :: ByteString
renderDims =
      (ByteString
"[" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)
      (ByteString -> ByteString)
-> (NP (K ByteString) ns -> ByteString)
-> NP (K ByteString) ns
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"]")
      (ByteString -> ByteString)
-> (NP (K ByteString) ns -> ByteString)
-> NP (K ByteString) ns
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"]["
      ([ByteString] -> ByteString)
-> (NP (K ByteString) ns -> [ByteString])
-> NP (K ByteString) ns
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP (K ByteString) ns -> [ByteString]
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
SOP.hcollapse
      (NP (K ByteString) ns -> ByteString)
-> NP (K ByteString) ns -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy KnownNat
-> (forall (a :: Nat). KnownNat a => Proxy a -> K ByteString a)
-> NP Proxy ns
-> NP (K ByteString) ns
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
SOP.hcmap (Proxy KnownNat
forall k (t :: k). Proxy t
SOP.Proxy @KnownNat)
        (ByteString -> K ByteString a
forall k a (b :: k). a -> K a b
SOP.K (ByteString -> K ByteString a)
-> (Proxy a -> ByteString) -> Proxy a -> K ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString)
-> (Proxy a -> String) -> Proxy a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Proxy a -> Integer) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal)
        ((forall (a :: Nat). Proxy a) -> NP Proxy ns
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
SOP.hpure forall k (t :: k). Proxy t
forall (a :: Nat). Proxy a
SOP.Proxy :: SOP.NP SOP.Proxy ns)
-- | text search query
tsvector :: TypeExpression db (null 'PGtsvector)
tsvector :: TypeExpression db (null 'PGtsvector)
tsvector = ByteString -> TypeExpression db (null 'PGtsvector)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"tsvector"
-- | text search document
tsquery :: TypeExpression db (null 'PGtsquery)
tsquery :: TypeExpression db (null 'PGtsquery)
tsquery = ByteString -> TypeExpression db (null 'PGtsquery)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"tsquery"
-- | Object identifiers (OIDs) are used internally by PostgreSQL
-- as primary keys for various system tables.
oid :: TypeExpression db (null 'PGoid)
oid :: TypeExpression db (null 'PGoid)
oid = ByteString -> TypeExpression db (null 'PGoid)
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"oid"
-- | Range of integer
int4range :: TypeExpression db (null ('PGrange 'PGint4))
int4range :: TypeExpression db (null ('PGrange 'PGint4))
int4range = ByteString -> TypeExpression db (null ('PGrange 'PGint4))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int4range"
-- | Range of bigint
int8range :: TypeExpression db (null ('PGrange 'PGint8))
int8range :: TypeExpression db (null ('PGrange 'PGint8))
int8range = ByteString -> TypeExpression db (null ('PGrange 'PGint8))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"int8range"
-- | Range of numeric
numrange :: TypeExpression db (null ('PGrange 'PGnumeric))
numrange :: TypeExpression db (null ('PGrange 'PGnumeric))
numrange = ByteString -> TypeExpression db (null ('PGrange 'PGnumeric))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"numrange"
-- | Range of timestamp without time zone
tsrange  :: TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange :: TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange = ByteString -> TypeExpression db (null ('PGrange 'PGtimestamp))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"tsrange"
-- | Range of timestamp with time zone
tstzrange :: TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange :: TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange = ByteString -> TypeExpression db (null ('PGrange 'PGtimestamptz))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"tstzrange"
-- | Range of date
daterange :: TypeExpression db (null ('PGrange 'PGdate))
daterange :: TypeExpression db (null ('PGrange 'PGdate))
daterange = ByteString -> TypeExpression db (null ('PGrange 'PGdate))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"daterange"
-- | Anonymous composite record
record :: TypeExpression db (null ('PGcomposite record))
record :: TypeExpression db (null ('PGcomposite record))
record = ByteString -> TypeExpression db (null ('PGcomposite record))
forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"record"

-- | `pgtype` is a demoted version of a `PGType`
class PGTyped db (ty :: PGType) where pgtype :: TypeExpression db (null ty)
instance PGTyped db 'PGbool where pgtype :: TypeExpression db (null 'PGbool)
pgtype = TypeExpression db (null 'PGbool)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGbool)
bool
instance PGTyped db 'PGint2 where pgtype :: TypeExpression db (null 'PGint2)
pgtype = TypeExpression db (null 'PGint2)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGint2)
int2
instance PGTyped db 'PGint4 where pgtype :: TypeExpression db (null 'PGint4)
pgtype = TypeExpression db (null 'PGint4)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGint4)
int4
instance PGTyped db 'PGint8 where pgtype :: TypeExpression db (null 'PGint8)
pgtype = TypeExpression db (null 'PGint8)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGint8)
int8
instance PGTyped db 'PGnumeric where pgtype :: TypeExpression db (null 'PGnumeric)
pgtype = TypeExpression db (null 'PGnumeric)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGnumeric)
numeric
instance PGTyped db 'PGfloat4 where pgtype :: TypeExpression db (null 'PGfloat4)
pgtype = TypeExpression db (null 'PGfloat4)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGfloat4)
float4
instance PGTyped db 'PGfloat8 where pgtype :: TypeExpression db (null 'PGfloat8)
pgtype = TypeExpression db (null 'PGfloat8)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGfloat8)
float8
instance PGTyped db 'PGmoney where pgtype :: TypeExpression db (null 'PGmoney)
pgtype = TypeExpression db (null 'PGmoney)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGmoney)
money
instance PGTyped db 'PGtext where pgtype :: TypeExpression db (null 'PGtext)
pgtype = TypeExpression db (null 'PGtext)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtext)
text
instance (KnownNat n, 1 <= n)
  => PGTyped db ('PGchar n) where pgtype :: TypeExpression db (null ('PGchar n))
pgtype = forall (db :: SchemasType) (null :: PGType -> NullType).
(KnownNat n, 1 <= n) =>
TypeExpression db (null ('PGchar n))
forall (n :: Nat) (db :: SchemasType) (null :: PGType -> NullType).
(KnownNat n, 1 <= n) =>
TypeExpression db (null ('PGchar n))
char @n
instance (KnownNat n, 1 <= n)
  => PGTyped db ('PGvarchar n) where pgtype :: TypeExpression db (null ('PGvarchar n))
pgtype = forall (db :: SchemasType) (null :: PGType -> NullType).
(KnownNat n, 1 <= n) =>
TypeExpression db (null ('PGvarchar n))
forall (n :: Nat) (db :: SchemasType) (null :: PGType -> NullType).
(KnownNat n, 1 <= n) =>
TypeExpression db (null ('PGvarchar n))
varchar @n
instance PGTyped db 'PGbytea where pgtype :: TypeExpression db (null 'PGbytea)
pgtype = TypeExpression db (null 'PGbytea)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGbytea)
bytea
instance PGTyped db 'PGtimestamp where pgtype :: TypeExpression db (null 'PGtimestamp)
pgtype = TypeExpression db (null 'PGtimestamp)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtimestamp)
timestamp
instance PGTyped db 'PGtimestamptz where pgtype :: TypeExpression db (null 'PGtimestamptz)
pgtype = TypeExpression db (null 'PGtimestamptz)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtimestamptz)
timestampWithTimeZone
instance PGTyped db 'PGdate where pgtype :: TypeExpression db (null 'PGdate)
pgtype = TypeExpression db (null 'PGdate)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGdate)
date
instance PGTyped db 'PGtime where pgtype :: TypeExpression db (null 'PGtime)
pgtype = TypeExpression db (null 'PGtime)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtime)
time
instance PGTyped db 'PGtimetz where pgtype :: TypeExpression db (null 'PGtimetz)
pgtype = TypeExpression db (null 'PGtimetz)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtimetz)
timeWithTimeZone
instance PGTyped db 'PGinterval where pgtype :: TypeExpression db (null 'PGinterval)
pgtype = TypeExpression db (null 'PGinterval)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGinterval)
interval
instance PGTyped db 'PGuuid where pgtype :: TypeExpression db (null 'PGuuid)
pgtype = TypeExpression db (null 'PGuuid)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGuuid)
uuid
instance PGTyped db 'PGinet where pgtype :: TypeExpression db (null 'PGinet)
pgtype = TypeExpression db (null 'PGinet)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGinet)
inet
instance PGTyped db 'PGjson where pgtype :: TypeExpression db (null 'PGjson)
pgtype = TypeExpression db (null 'PGjson)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGjson)
json
instance PGTyped db 'PGjsonb where pgtype :: TypeExpression db (null 'PGjsonb)
pgtype = TypeExpression db (null 'PGjsonb)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGjsonb)
jsonb
instance PGTyped db pg => PGTyped db ('PGvararray (null pg)) where
  pgtype :: TypeExpression db (null ('PGvararray (null pg)))
pgtype = TypeExpression db (null pg)
-> TypeExpression db (null ('PGvararray (null pg)))
forall (db :: SchemasType) (pg :: NullType)
       (null :: PGType -> NullType).
TypeExpression db pg -> TypeExpression db (null ('PGvararray pg))
vararray (forall (null :: PGType -> NullType).
PGTyped db pg =>
TypeExpression db (null pg)
forall (db :: SchemasType) (ty :: PGType)
       (null :: PGType -> NullType).
PGTyped db ty =>
TypeExpression db (null ty)
pgtype @db @pg)
instance (SOP.All KnownNat dims, PGTyped db pg)
  => PGTyped db ('PGfixarray dims (null pg)) where
    pgtype :: TypeExpression db (null ('PGfixarray dims (null pg)))
pgtype = TypeExpression db (null pg)
-> TypeExpression db (null ('PGfixarray dims (null pg)))
forall (dims :: [Nat]) (db :: SchemasType)
       (null :: PGType -> NullType) (pg :: NullType).
All KnownNat dims =>
TypeExpression db pg
-> TypeExpression db (null ('PGfixarray dims pg))
fixarray @dims (forall (null :: PGType -> NullType).
PGTyped db pg =>
TypeExpression db (null pg)
forall (db :: SchemasType) (ty :: PGType)
       (null :: PGType -> NullType).
PGTyped db ty =>
TypeExpression db (null ty)
pgtype @db @pg)
instance PGTyped db 'PGtsvector where pgtype :: TypeExpression db (null 'PGtsvector)
pgtype = TypeExpression db (null 'PGtsvector)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtsvector)
tsvector
instance PGTyped db 'PGtsquery where pgtype :: TypeExpression db (null 'PGtsquery)
pgtype = TypeExpression db (null 'PGtsquery)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGtsquery)
tsquery
instance PGTyped db 'PGoid where pgtype :: TypeExpression db (null 'PGoid)
pgtype = TypeExpression db (null 'PGoid)
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null 'PGoid)
oid
instance PGTyped db ('PGrange 'PGint4) where pgtype :: TypeExpression db (null ('PGrange 'PGint4))
pgtype = TypeExpression db (null ('PGrange 'PGint4))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint4))
int4range
instance PGTyped db ('PGrange 'PGint8) where pgtype :: TypeExpression db (null ('PGrange 'PGint8))
pgtype = TypeExpression db (null ('PGrange 'PGint8))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint8))
int8range
instance PGTyped db ('PGrange 'PGnumeric) where pgtype :: TypeExpression db (null ('PGrange 'PGnumeric))
pgtype = TypeExpression db (null ('PGrange 'PGnumeric))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGnumeric))
numrange
instance PGTyped db ('PGrange 'PGtimestamp) where pgtype :: TypeExpression db (null ('PGrange 'PGtimestamp))
pgtype = TypeExpression db (null ('PGrange 'PGtimestamp))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange
instance PGTyped db ('PGrange 'PGtimestamptz) where pgtype :: TypeExpression db (null ('PGrange 'PGtimestamptz))
pgtype = TypeExpression db (null ('PGrange 'PGtimestamptz))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange
instance PGTyped db ('PGrange 'PGdate) where pgtype :: TypeExpression db (null ('PGrange 'PGdate))
pgtype = TypeExpression db (null ('PGrange 'PGdate))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGdate))
daterange
instance
  ( relss ~ DbRelations db
  , Has sch relss rels
  , Has rel rels row
  , FindQualified "no relation found with row:" relss row ~ '(sch,rel)  
  ) => PGTyped db ('PGcomposite row) where
    pgtype :: TypeExpression db (null ('PGcomposite row))
pgtype = QualifiedAlias sch rel
-> TypeExpression db (null ('PGcomposite row))
forall (relss :: [(Symbol, FromType)]) (db :: SchemasType)
       (sch :: Symbol) (rels :: FromType) (rel :: Symbol) (row :: RowType)
       (null :: PGType -> NullType).
(relss ~ DbRelations db, Has sch relss rels, Has rel rels row) =>
QualifiedAlias sch rel
-> TypeExpression db (null ('PGcomposite row))
typerow (QualifiedAlias sch rel
forall (qualifier :: Symbol) (alias :: Symbol).
QualifiedAlias qualifier alias
QualifiedAlias @sch @rel)
instance
  ( enums ~ DbEnums db
  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)
  , Has sch db schema
  , Has td schema ('Typedef ('PGenum labels))
  ) => PGTyped db ('PGenum labels) where
    pgtype :: TypeExpression db (null ('PGenum labels))
pgtype = QualifiedAlias sch td -> TypeExpression db (null ('PGenum labels))
forall (sch :: Symbol) (db :: SchemasType)
       (schema :: [(Symbol, SchemumType)]) (td :: Symbol) (ty :: PGType)
       (null :: PGType -> NullType).
(Has sch db schema, Has td schema ('Typedef ty)) =>
QualifiedAlias sch td -> TypeExpression db (null ty)
typedef (QualifiedAlias sch td
forall (qualifier :: Symbol) (alias :: Symbol).
QualifiedAlias qualifier alias
QualifiedAlias @sch @td)

-- | Specify `TypeExpression` from a Haskell type.
--
-- >>> printSQL $ pgtypeFrom @String
-- text
--
-- >>> printSQL $ pgtypeFrom @Double
-- float8
pgtypeFrom
  :: forall hask db null. PGTyped db (PG hask)
  => TypeExpression db (null (PG hask))
pgtypeFrom :: TypeExpression db (null (PG hask))
pgtypeFrom = forall (null :: PGType -> NullType).
PGTyped db (PG hask) =>
TypeExpression db (null (PG hask))
forall (db :: SchemasType) (ty :: PGType)
       (null :: PGType -> NullType).
PGTyped db ty =>
TypeExpression db (null ty)
pgtype @db @(PG hask)

-- | Lift `PGTyped` to a field
class FieldTyped db ty where fieldtype :: Aliased (TypeExpression db) ty
instance (KnownSymbol alias, NullTyped db ty)
  => FieldTyped db (alias ::: ty) where
    fieldtype :: Aliased (TypeExpression db) (alias ::: ty)
fieldtype = TypeExpression db ty
forall (db :: SchemasType) (ty :: NullType).
NullTyped db ty =>
TypeExpression db ty
nulltype TypeExpression db ty
-> Alias alias -> Aliased (TypeExpression db) (alias ::: ty)
forall k (alias :: Symbol) (expression :: k -> *) (ty :: k).
KnownSymbol alias =>
expression ty -> Alias alias -> Aliased expression (alias ::: ty)
`As` Alias alias
forall (alias :: Symbol). Alias alias
Alias

-- | `ColumnTypeExpression`s are used in
-- `Squeal.PostgreSQL.Definition.createTable` commands.
newtype ColumnTypeExpression (db :: SchemasType) (ty :: ColumnType)
  = UnsafeColumnTypeExpression { ColumnTypeExpression db ty -> ByteString
renderColumnTypeExpression :: ByteString }
  deriving stock ((forall x.
 ColumnTypeExpression db ty -> Rep (ColumnTypeExpression db ty) x)
-> (forall x.
    Rep (ColumnTypeExpression db ty) x -> ColumnTypeExpression db ty)
-> Generic (ColumnTypeExpression db ty)
forall (db :: SchemasType) (ty :: ColumnType) x.
Rep (ColumnTypeExpression db ty) x -> ColumnTypeExpression db ty
forall (db :: SchemasType) (ty :: ColumnType) x.
ColumnTypeExpression db ty -> Rep (ColumnTypeExpression db ty) x
forall x.
Rep (ColumnTypeExpression db ty) x -> ColumnTypeExpression db ty
forall x.
ColumnTypeExpression db ty -> Rep (ColumnTypeExpression db ty) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (db :: SchemasType) (ty :: ColumnType) x.
Rep (ColumnTypeExpression db ty) x -> ColumnTypeExpression db ty
$cfrom :: forall (db :: SchemasType) (ty :: ColumnType) x.
ColumnTypeExpression db ty -> Rep (ColumnTypeExpression db ty) x
GHC.Generic,Int -> ColumnTypeExpression db ty -> ShowS
[ColumnTypeExpression db ty] -> ShowS
ColumnTypeExpression db ty -> String
(Int -> ColumnTypeExpression db ty -> ShowS)
-> (ColumnTypeExpression db ty -> String)
-> ([ColumnTypeExpression db ty] -> ShowS)
-> Show (ColumnTypeExpression db ty)
forall (db :: SchemasType) (ty :: ColumnType).
Int -> ColumnTypeExpression db ty -> ShowS
forall (db :: SchemasType) (ty :: ColumnType).
[ColumnTypeExpression db ty] -> ShowS
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnTypeExpression db ty] -> ShowS
$cshowList :: forall (db :: SchemasType) (ty :: ColumnType).
[ColumnTypeExpression db ty] -> ShowS
show :: ColumnTypeExpression db ty -> String
$cshow :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> String
showsPrec :: Int -> ColumnTypeExpression db ty -> ShowS
$cshowsPrec :: forall (db :: SchemasType) (ty :: ColumnType).
Int -> ColumnTypeExpression db ty -> ShowS
Show,ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
(ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Bool)
-> Eq (ColumnTypeExpression db ty)
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c/= :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
== :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c== :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
Eq,Eq (ColumnTypeExpression db ty)
Eq (ColumnTypeExpression db ty)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Ordering)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Bool)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Bool)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Bool)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> Bool)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> ColumnTypeExpression db ty)
-> (ColumnTypeExpression db ty
    -> ColumnTypeExpression db ty -> ColumnTypeExpression db ty)
-> Ord (ColumnTypeExpression db ty)
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> Ordering
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
forall (db :: SchemasType) (ty :: ColumnType).
Eq (ColumnTypeExpression db ty)
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> Ordering
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
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 :: ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
$cmin :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
max :: ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
$cmax :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> ColumnTypeExpression db ty
>= :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c>= :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
> :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c> :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
<= :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c<= :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
< :: ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
$c< :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ColumnTypeExpression db ty -> Bool
compare :: ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> Ordering
$ccompare :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty
-> ColumnTypeExpression db ty -> Ordering
$cp1Ord :: forall (db :: SchemasType) (ty :: ColumnType).
Eq (ColumnTypeExpression db ty)
Ord)
  deriving newtype (ColumnTypeExpression db ty -> ()
(ColumnTypeExpression db ty -> ())
-> NFData (ColumnTypeExpression db ty)
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ()
forall a. (a -> ()) -> NFData a
rnf :: ColumnTypeExpression db ty -> ()
$crnf :: forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ()
NFData)
instance RenderSQL (ColumnTypeExpression db ty) where
  renderSQL :: ColumnTypeExpression db ty -> ByteString
renderSQL = ColumnTypeExpression db ty -> ByteString
forall (db :: SchemasType) (ty :: ColumnType).
ColumnTypeExpression db ty -> ByteString
renderColumnTypeExpression

-- | used in `Squeal.PostgreSQL.Definition.createTable`
-- commands as a column constraint to note that
-- @NULL@ may be present in a column
nullable
  :: TypeExpression db (null ty)
  -- ^ type
  -> ColumnTypeExpression db ('NoDef :=> 'Null ty)
nullable :: TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'Null ty)
nullable TypeExpression db (null ty)
ty = ByteString -> ColumnTypeExpression db ('NoDef :=> 'Null ty)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression (ByteString -> ColumnTypeExpression db ('NoDef :=> 'Null ty))
-> ByteString -> ColumnTypeExpression db ('NoDef :=> 'Null ty)
forall a b. (a -> b) -> a -> b
$ TypeExpression db (null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db (null ty)
ty ByteString -> ByteString -> ByteString
<+> ByteString
"NULL"

-- | used in `Squeal.PostgreSQL.Definition.createTable`
-- commands as a column constraint to ensure
-- @NULL@ is not present in a column
notNullable
  :: TypeExpression db (null ty)
  -- ^ type
  -> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable :: TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable TypeExpression db (null ty)
ty = ByteString -> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression (ByteString -> ColumnTypeExpression db ('NoDef :=> 'NotNull ty))
-> ByteString -> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
forall a b. (a -> b) -> a -> b
$ TypeExpression db (null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db (null ty)
ty ByteString -> ByteString -> ByteString
<+> ByteString
"NOT NULL"

-- | used in `Squeal.PostgreSQL.Definition.createTable`
-- commands as a column constraint to give a default
default_
  :: Expression 'Ungrouped '[] '[] db '[] '[] ty
  -- ^ default value
  -> ColumnTypeExpression db ('NoDef :=> ty)
  -- ^ column type
  -> ColumnTypeExpression db ('Def :=> ty)
default_ :: Expression 'Ungrouped '[] '[] db '[] '[] ty
-> ColumnTypeExpression db ('NoDef :=> ty)
-> ColumnTypeExpression db ('Def :=> ty)
default_ Expression 'Ungrouped '[] '[] db '[] '[] ty
x ColumnTypeExpression db ('NoDef :=> ty)
ty = ByteString -> ColumnTypeExpression db ('Def :=> ty)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression (ByteString -> ColumnTypeExpression db ('Def :=> ty))
-> ByteString -> ColumnTypeExpression db ('Def :=> ty)
forall a b. (a -> b) -> a -> b
$
  ColumnTypeExpression db ('NoDef :=> ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ColumnTypeExpression db ('NoDef :=> ty)
ty ByteString -> ByteString -> ByteString
<+> ByteString
"DEFAULT" ByteString -> ByteString -> ByteString
<+> Expression 'Ungrouped '[] '[] db '[] '[] ty -> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Expression grp lat with db params from ty -> ByteString
renderExpression Expression 'Ungrouped '[] '[] db '[] '[] ty
x

-- | not a true type, but merely a notational convenience for creating
-- unique identifier columns with type `PGint2`
serial2, smallserial
  :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
serial2 :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
serial2 = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"serial2"
smallserial :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
smallserial = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"smallserial"
-- | not a true type, but merely a notational convenience for creating
-- unique identifier columns with type `PGint4`
serial4, serial
  :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
serial4 :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
serial4 = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"serial4"
serial :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
serial = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"serial"
-- | not a true type, but merely a notational convenience for creating
-- unique identifier columns with type `PGint8`
serial8, bigserial
  :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
serial8 :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
serial8 = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"serial8"
bigserial :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
bigserial = ByteString -> ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)
forall (db :: SchemasType) (ty :: ColumnType).
ByteString -> ColumnTypeExpression db ty
UnsafeColumnTypeExpression ByteString
"bigserial"

-- | Like @PGTyped@ but also accounts for null.
class NullTyped db (ty :: NullType) where
  nulltype :: TypeExpression db ty

instance PGTyped db ty => NullTyped db (null ty) where
  nulltype :: TypeExpression db (null ty)
nulltype = forall (null :: PGType -> NullType).
PGTyped db ty =>
TypeExpression db (null ty)
forall (db :: SchemasType) (ty :: PGType)
       (null :: PGType -> NullType).
PGTyped db ty =>
TypeExpression db (null ty)
pgtype @db @ty

-- | Specify null `TypeExpression` from a Haskell type.
--
-- >>> printSQL $ nulltypeFrom @(Maybe String)
-- text
--
-- >>> printSQL $ nulltypeFrom @Double
-- float8
nulltypeFrom
  :: forall hask db. NullTyped db (NullPG hask)
  => TypeExpression db (NullPG hask)
nulltypeFrom :: TypeExpression db (NullPG hask)
nulltypeFrom = NullTyped db (NullPG hask) => TypeExpression db (NullPG hask)
forall (db :: SchemasType) (ty :: NullType).
NullTyped db ty =>
TypeExpression db ty
nulltype @db @(NullPG hask)

-- | Like @PGTyped@ but also accounts for null.
class ColumnTyped db (column :: ColumnType) where
  columntype :: ColumnTypeExpression db column
instance NullTyped db ('Null ty)
  => ColumnTyped db ('NoDef :=> 'Null ty) where
    columntype :: ColumnTypeExpression db ('NoDef :=> 'Null ty)
columntype = TypeExpression db ('Null ty)
-> ColumnTypeExpression db ('NoDef :=> 'Null ty)
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType).
TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'Null ty)
nullable (NullTyped db ('Null ty) => TypeExpression db ('Null ty)
forall (db :: SchemasType) (ty :: NullType).
NullTyped db ty =>
TypeExpression db ty
nulltype @db @('Null ty))
instance NullTyped db ('NotNull ty)
  => ColumnTyped db ('NoDef :=> 'NotNull ty) where
    columntype :: ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
columntype = TypeExpression db ('NotNull ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType).
TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable (NullTyped db ('NotNull ty) => TypeExpression db ('NotNull ty)
forall (db :: SchemasType) (ty :: NullType).
NullTyped db ty =>
TypeExpression db ty
nulltype @db @('NotNull ty))

-- | Specify `ColumnTypeExpression` from a Haskell type.
--
-- >>> printSQL $ columntypeFrom @(Maybe String)
-- text NULL
--
-- >>> printSQL $ columntypeFrom @Double
-- float8 NOT NULL
columntypeFrom
  :: forall hask db. (ColumnTyped db ('NoDef :=> NullPG hask))
  => ColumnTypeExpression db ('NoDef :=> NullPG hask)
columntypeFrom :: ColumnTypeExpression db ('NoDef :=> NullPG hask)
columntypeFrom = ColumnTyped db ('NoDef :=> NullPG hask) =>
ColumnTypeExpression db ('NoDef :=> NullPG hask)
forall (db :: SchemasType) (column :: ColumnType).
ColumnTyped db column =>
ColumnTypeExpression db column
columntype @db @('NoDef :=> NullPG hask)