content: {-|
  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 ty x = UnsafeExpression $ parenthesized $
    renderSQL x <+> "::" <+> renderSQL 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 = 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 = astype nulltype
  
  {-----------------------------------------
  type expressions
  -----------------------------------------}
  
  -- | `TypeExpression`s are used in `cast`s and
  -- `Squeal.PostgreSQL.Definition.createTable` commands.
  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
  
  -- | 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 = UnsafeTypeExpression . 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 = UnsafeTypeExpression . 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 = UnsafeTypeExpression . 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 = UnsafeTypeExpression . 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 = UnsafeTypeExpression . renderSQL
  
  -- | logical Boolean (true/false)
  bool :: TypeExpression db (null 'PGbool)
  bool = UnsafeTypeExpression "bool"
  -- | signed two-byte integer
  int2, smallint :: TypeExpression db (null 'PGint2)
  int2 = UnsafeTypeExpression "int2"
  smallint = UnsafeTypeExpression "smallint"
  -- | signed four-byte integer
  int4, int, integer :: TypeExpression db (null 'PGint4)
  int4 = UnsafeTypeExpression "int4"
  int = UnsafeTypeExpression "int"
  integer = UnsafeTypeExpression "integer"
  -- | signed eight-byte integer
  int8, bigint :: TypeExpression db (null 'PGint8)
  int8 = UnsafeTypeExpression "int8"
  bigint = UnsafeTypeExpression "bigint"
  -- | arbitrary precision numeric type
  numeric :: TypeExpression db (null 'PGnumeric)
  numeric = UnsafeTypeExpression "numeric"
  -- | single precision floating-point number (4 bytes)
  float4, real :: TypeExpression db (null 'PGfloat4)
  float4 = UnsafeTypeExpression "float4"
  real = UnsafeTypeExpression "real"
  -- | double precision floating-point number (8 bytes)
  float8, doublePrecision :: TypeExpression db (null 'PGfloat8)
  float8 = UnsafeTypeExpression "float8"
  doublePrecision = UnsafeTypeExpression "double precision"
  -- | currency amount
  money :: TypeExpression schema (null 'PGmoney)
  money = UnsafeTypeExpression "money"
  -- | variable-length character string
  text :: TypeExpression db (null 'PGtext)
  text = UnsafeTypeExpression "text"
  -- | fixed-length character string
  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 <> ")"
  -- | variable-length character string
  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 <> ")"
  -- | binary data ("byte array")
  bytea :: TypeExpression db (null 'PGbytea)
  bytea = UnsafeTypeExpression "bytea"
  -- | date and time (no time zone)
  timestamp :: TypeExpression db (null 'PGtimestamp)
  timestamp = UnsafeTypeExpression "timestamp"
  -- | date and time, including time zone
  timestampWithTimeZone, timestamptz :: TypeExpression db (null 'PGtimestamptz)
  timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
  timestamptz = UnsafeTypeExpression "timestamptz"
  -- | calendar date (year, month, day)
  date :: TypeExpression db (null 'PGdate)
  date = UnsafeTypeExpression "date"
  -- | time of day (no time zone)
  time :: TypeExpression db (null 'PGtime)
  time = UnsafeTypeExpression "time"
  -- | time of day, including time zone
  timeWithTimeZone, timetz :: TypeExpression db (null 'PGtimetz)
  timeWithTimeZone = UnsafeTypeExpression "time with time zone"
  timetz = UnsafeTypeExpression "timetz"
  -- | time span
  interval :: TypeExpression db (null 'PGinterval)
  interval = UnsafeTypeExpression "interval"
  -- | universally unique identifier
  uuid :: TypeExpression db (null 'PGuuid)
  uuid = UnsafeTypeExpression "uuid"
  -- | IPv4 or IPv6 host address
  inet :: TypeExpression db (null 'PGinet)
  inet = UnsafeTypeExpression "inet"
  -- | textual JSON data
  json :: TypeExpression db (null 'PGjson)
  json = UnsafeTypeExpression "json"
  -- | binary JSON data, decomposed
  jsonb :: TypeExpression db (null 'PGjsonb)
  jsonb = UnsafeTypeExpression "jsonb"
  -- | variable length array
  vararray
    :: TypeExpression db pg
    -> TypeExpression db (null ('PGvararray pg))
  vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"
  -- | 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 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)
  -- | text search query
  tsvector :: TypeExpression db (null 'PGtsvector)
  tsvector = UnsafeTypeExpression "tsvector"
  -- | text search document
  tsquery :: TypeExpression db (null 'PGtsquery)
  tsquery = UnsafeTypeExpression "tsquery"
  -- | Object identifiers (OIDs) are used internally by PostgreSQL
  -- as primary keys for various system tables.
  oid :: TypeExpression db (null 'PGoid)
  oid = UnsafeTypeExpression "oid"
  -- | Range of integer
  int4range :: TypeExpression db (null ('PGrange 'PGint4))
  int4range = UnsafeTypeExpression "int4range"
  -- | Range of bigint
  int8range :: TypeExpression db (null ('PGrange 'PGint8))
  int8range = UnsafeTypeExpression "int8range"
  -- | Range of numeric
  numrange :: TypeExpression db (null ('PGrange 'PGnumeric))
  numrange = UnsafeTypeExpression "numrange"
  -- | Range of timestamp without time zone
  tsrange  :: TypeExpression db (null ('PGrange 'PGtimestamp))
  tsrange = UnsafeTypeExpression "tsrange"
  -- | Range of timestamp with time zone
  tstzrange :: TypeExpression db (null ('PGrange 'PGtimestamptz))
  tstzrange = UnsafeTypeExpression "tstzrange"
  -- | Range of date
  daterange :: TypeExpression db (null ('PGrange 'PGdate))
  daterange = UnsafeTypeExpression "daterange"
  -- | Anonymous composite record
  record :: TypeExpression db (null ('PGcomposite record))
  record = UnsafeTypeExpression "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 = 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 'PGinet where pgtype = inet
  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
    ( 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 = typerow (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 = typedef (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 = 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 = nulltype `As` Alias
  
  -- | `ColumnTypeExpression`s are used in
  -- `Squeal.PostgreSQL.Definition.createTable` commands.
  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
  
  -- | 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 ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "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 ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "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_ x ty = UnsafeColumnTypeExpression $
    renderSQL ty <+> "DEFAULT" <+> renderExpression 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 = UnsafeColumnTypeExpression "serial2"
  smallserial = UnsafeColumnTypeExpression "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 = UnsafeColumnTypeExpression "serial4"
  serial = UnsafeColumnTypeExpression "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 = UnsafeColumnTypeExpression "serial8"
  bigserial = UnsafeColumnTypeExpression "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 = 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 = 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 = nullable (nulltype @db @('Null ty))
  instance NullTyped db ('NotNull ty)
    => ColumnTyped db ('NoDef :=> 'NotNull ty) where
      columntype = notNullable (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 = columntype @db @('NoDef :=> NullPG hask)
  