{-# LANGUAGE
AllowAmbiguousTypes
, ConstraintKinds
, DeriveAnyClass
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, LambdaCase
, MultiParamTypeClasses
, OverloadedLabels
, OverloadedStrings
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, TypeInType
, TypeOperators
, UndecidableSuperClasses
#-}
module Squeal.PostgreSQL.Definition.Type
(
createTypeEnum
, createTypeEnumFrom
, createTypeComposite
, createTypeCompositeFrom
, createTypeRange
, createDomain
, dropType
, dropTypeIfExists
, alterTypeRename
, alterTypeSetSchema
) where
import Data.ByteString
import Data.Monoid
import GHC.TypeLits
import Prelude hiding ((.), id)
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Expression.Type
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Type.Schema
createTypeEnum
:: (KnownSymbol enum, Has sch db schema, SOP.All KnownSymbol labels)
=> QualifiedAlias sch enum
-> NP PGlabel labels
-> Definition db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
createTypeEnum :: QualifiedAlias sch enum
-> NP PGlabel labels
-> Definition
db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
createTypeEnum QualifiedAlias sch enum
enum NP PGlabel labels
labels = ByteString
-> Definition
db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition
db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db))
-> ByteString
-> Definition
db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
forall a b. (a -> b) -> a -> b
$
ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch enum -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch enum
enum ByteString -> ByteString -> ByteString
<+> ByteString
"AS" ByteString -> ByteString -> ByteString
<+> ByteString
"ENUM" ByteString -> ByteString -> ByteString
<+>
ByteString -> ByteString
parenthesized (NP PGlabel labels -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL NP PGlabel labels
labels) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
createTypeEnumFrom
:: forall hask sch enum db schema.
( SOP.Generic hask
, SOP.All KnownSymbol (LabelsPG hask)
, KnownSymbol enum
, Has sch db schema )
=> QualifiedAlias sch enum
-> Definition db (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) db)
createTypeEnumFrom :: QualifiedAlias sch enum
-> Definition
db
(Alter
sch (Create enum ('Typedef (PG (Enumerated hask))) schema) db)
createTypeEnumFrom QualifiedAlias sch enum
enum = QualifiedAlias sch enum
-> NP
PGlabel (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask)))
-> Definition
db
(Alter
sch
(Create
enum
('Typedef
('PGenum
(ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask)))))
schema)
db)
forall (enum :: Symbol) (sch :: Symbol) (db :: SchemasType)
(schema :: [(Symbol, SchemumType)]) (labels :: [Symbol]).
(KnownSymbol enum, Has sch db schema, All KnownSymbol labels) =>
QualifiedAlias sch enum
-> NP PGlabel labels
-> Definition
db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
createTypeEnum QualifiedAlias sch enum
enum
((forall (a :: Symbol). PGlabel a)
-> NP
PGlabel (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask)))
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 (a :: Symbol). PGlabel a
forall (label :: Symbol) expr. IsPGlabel label expr => expr
label :: NP PGlabel (LabelsPG hask))
createTypeComposite
:: (KnownSymbol ty, Has sch db schema, SOP.SListI fields)
=> QualifiedAlias sch ty
-> NP (Aliased (TypeExpression db)) fields
-> Definition db (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
createTypeComposite :: QualifiedAlias sch ty
-> NP (Aliased (TypeExpression db)) fields
-> Definition
db
(Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
createTypeComposite QualifiedAlias sch ty
ty NP (Aliased (TypeExpression db)) fields
fields = ByteString
-> Definition
db
(Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition
db
(Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db))
-> ByteString
-> Definition
db
(Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
forall a b. (a -> b) -> a -> b
$
ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch ty
ty ByteString -> ByteString -> ByteString
<+> ByteString
"AS" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized
((forall (x :: (Symbol, NullType)).
Aliased (TypeExpression db) x -> ByteString)
-> NP (Aliased (TypeExpression db)) fields -> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall (db :: SchemasType) (x :: (Symbol, NullType)).
Aliased (TypeExpression db) x -> ByteString
forall (x :: (Symbol, NullType)).
Aliased (TypeExpression db) x -> ByteString
renderField NP (Aliased (TypeExpression db)) fields
fields) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
where
renderField :: Aliased (TypeExpression db) x -> ByteString
renderField :: Aliased (TypeExpression db) x -> ByteString
renderField (TypeExpression db ty
typ `As` Alias alias
alias) =
Alias alias -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
alias ByteString -> ByteString -> ByteString
<+> TypeExpression db ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db ty
typ
createTypeCompositeFrom
:: forall hask sch ty db schema.
( SOP.All (FieldTyped db) (RowPG hask)
, KnownSymbol ty
, Has sch db schema )
=> QualifiedAlias sch ty
-> Definition db (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) db)
createTypeCompositeFrom :: QualifiedAlias sch ty
-> Definition
db
(Alter sch (Create ty ('Typedef (PG (Composite hask))) schema) db)
createTypeCompositeFrom QualifiedAlias sch ty
ty = QualifiedAlias sch ty
-> NP
(Aliased (TypeExpression db))
(RowOf
(ToRecordCode_Datatype hask (DatatypeInfoOf hask) (Code hask)))
-> Definition
db
(Alter
sch
(Create
ty
('Typedef
('PGcomposite
(RowOf
(ToRecordCode_Datatype hask (DatatypeInfoOf hask) (Code hask)))))
schema)
db)
forall (ty :: Symbol) (sch :: Symbol) (db :: SchemasType)
(schema :: [(Symbol, SchemumType)])
(fields :: [(Symbol, NullType)]).
(KnownSymbol ty, Has sch db schema, SListI fields) =>
QualifiedAlias sch ty
-> NP (Aliased (TypeExpression db)) fields
-> Definition
db
(Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
createTypeComposite QualifiedAlias sch ty
ty
(Proxy (FieldTyped db)
-> (forall (a :: (Symbol, NullType)).
FieldTyped db a =>
Aliased (TypeExpression db) a)
-> NP
(Aliased (TypeExpression db))
(RowOf
(ToRecordCode_Datatype hask (DatatypeInfoOf hask) (Code hask)))
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
SOP.hcpure (Proxy (FieldTyped db)
forall k (t :: k). Proxy t
SOP.Proxy :: SOP.Proxy (FieldTyped db)) forall (db :: SchemasType) (ty :: (Symbol, NullType)).
FieldTyped db ty =>
Aliased (TypeExpression db) ty
forall (a :: (Symbol, NullType)).
FieldTyped db a =>
Aliased (TypeExpression db) a
fieldtype
:: NP (Aliased (TypeExpression db)) (RowPG hask))
createDomain
:: (Has sch db schema, KnownSymbol dom)
=> QualifiedAlias sch dom
-> (forall null. TypeExpression db (null ty))
-> (forall tab. Condition 'Ungrouped '[] '[] db '[] '[tab ::: '["value" ::: 'Null ty]])
-> Definition db (Alter sch (Create dom ('Typedef ty) schema) db)
createDomain :: QualifiedAlias sch dom
-> (forall (null :: PGType -> NullType).
TypeExpression db (null ty))
-> (forall (tab :: Symbol).
Condition
'Ungrouped '[] '[] db '[] '[tab ::: '["value" ::: 'Null ty]])
-> Definition db (Alter sch (Create dom ('Typedef ty) schema) db)
createDomain QualifiedAlias sch dom
dom forall (null :: PGType -> NullType). TypeExpression db (null ty)
ty forall (tab :: Symbol).
Condition
'Ungrouped '[] '[] db '[] '[tab ::: '["value" ::: 'Null ty]]
condition =
ByteString
-> Definition db (Alter sch (Create dom ('Typedef ty) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition db (Alter sch (Create dom ('Typedef ty) schema) db))
-> ByteString
-> Definition db (Alter sch (Create dom ('Typedef ty) schema) db)
forall a b. (a -> b) -> a -> b
$ ByteString
"CREATE DOMAIN" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch dom -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch dom
dom
ByteString -> ByteString -> ByteString
<+> ByteString
"AS" ByteString -> ByteString -> ByteString
<+> TypeExpression db (Any ty) -> ByteString
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> ByteString
renderTypeExpression TypeExpression db (Any ty)
forall (null :: PGType -> NullType). TypeExpression db (null ty)
ty
ByteString -> ByteString -> ByteString
<+> ByteString
"CHECK" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (Condition
'Ungrouped '[] '[] db '[] '[Any ::: '["value" ::: 'Null ty]]
-> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Condition
'Ungrouped '[] '[] db '[] '[Any ::: '["value" ::: 'Null ty]]
forall (tab :: Symbol).
Condition
'Ungrouped '[] '[] db '[] '[tab ::: '["value" ::: 'Null ty]]
condition) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
createTypeRange
:: (Has sch db schema, KnownSymbol range)
=> QualifiedAlias sch range
-> (forall null. TypeExpression db (null ty))
-> Definition db (Alter sch (Create range ('Typedef ('PGrange ty)) schema) db)
createTypeRange :: QualifiedAlias sch range
-> (forall (null :: PGType -> NullType).
TypeExpression db (null ty))
-> Definition
db (Alter sch (Create range ('Typedef ('PGrange ty)) schema) db)
createTypeRange QualifiedAlias sch range
range forall (null :: PGType -> NullType). TypeExpression db (null ty)
ty = ByteString
-> Definition
db (Alter sch (Create range ('Typedef ('PGrange ty)) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition
db (Alter sch (Create range ('Typedef ('PGrange ty)) schema) db))
-> ByteString
-> Definition
db (Alter sch (Create range ('Typedef ('PGrange ty)) schema) db)
forall a b. (a -> b) -> a -> b
$
ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch range -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch range
range ByteString -> ByteString -> ByteString
<+> ByteString
"AS" ByteString -> ByteString -> ByteString
<+> ByteString
"RANGE" ByteString -> ByteString -> ByteString
<+>
ByteString -> ByteString
parenthesized (ByteString
"subtype" ByteString -> ByteString -> ByteString
<+> ByteString
"=" ByteString -> ByteString -> ByteString
<+> TypeExpression db (Any ty) -> ByteString
forall (db :: SchemasType) (ty :: NullType).
TypeExpression db ty -> ByteString
renderTypeExpression TypeExpression db (Any ty)
forall (null :: PGType -> NullType). TypeExpression db (null ty)
ty) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
dropType
:: (Has sch db schema, KnownSymbol td)
=> QualifiedAlias sch td
-> Definition db (Alter sch (DropSchemum td 'Typedef schema) db)
dropType :: QualifiedAlias sch td
-> Definition db (Alter sch (DropSchemum td 'Typedef schema) db)
dropType QualifiedAlias sch td
tydef = ByteString
-> Definition db (Alter sch (DropSchemum td 'Typedef schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition db (Alter sch (DropSchemum td 'Typedef schema) db))
-> ByteString
-> Definition db (Alter sch (DropSchemum td 'Typedef schema) db)
forall a b. (a -> b) -> a -> b
$ ByteString
"DROP TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch td -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch td
tydef ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
dropTypeIfExists
:: (Has sch db schema, KnownSymbol td)
=> QualifiedAlias sch td
-> Definition db (Alter sch (DropSchemumIfExists td 'Typedef schema) db)
dropTypeIfExists :: QualifiedAlias sch td
-> Definition
db (Alter sch (DropSchemumIfExists td 'Typedef schema) db)
dropTypeIfExists QualifiedAlias sch td
tydef = ByteString
-> Definition
db (Alter sch (DropSchemumIfExists td 'Typedef schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition
db (Alter sch (DropSchemumIfExists td 'Typedef schema) db))
-> ByteString
-> Definition
db (Alter sch (DropSchemumIfExists td 'Typedef schema) db)
forall a b. (a -> b) -> a -> b
$
ByteString
"DROP TYPE IF EXISTS" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch td -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch td
tydef ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
alterTypeRename
:: ( Has sch db schema
, KnownSymbol ty1
, Has ty0 schema ('Typedef ty))
=> QualifiedAlias sch ty0
-> Alias ty1
-> Definition db (Alter sch (Rename ty0 ty1 schema) db )
alterTypeRename :: QualifiedAlias sch ty0
-> Alias ty1
-> Definition db (Alter sch (Rename ty0 ty1 schema) db)
alterTypeRename QualifiedAlias sch ty0
ty0 Alias ty1
ty1 = ByteString -> Definition db (Alter sch (Rename ty0 ty1 schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition db (Alter sch (Rename ty0 ty1 schema) db))
-> ByteString
-> Definition db (Alter sch (Rename ty0 ty1 schema) db)
forall a b. (a -> b) -> a -> b
$
ByteString
"ALTER TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch ty0 -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch ty0
ty0
ByteString -> ByteString -> ByteString
<+> ByteString
"RENAME TO" ByteString -> ByteString -> ByteString
<+> Alias ty1 -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias ty1
ty1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
alterTypeSetSchema
:: ( Has sch0 db schema0
, Has ty schema0 ('Typedef td)
, Has sch1 db schema1 )
=> QualifiedAlias sch0 ty
-> Alias sch1
-> Definition db (SetSchema sch0 sch1 schema0 schema1 ty 'Typedef td db)
alterTypeSetSchema :: QualifiedAlias sch0 ty
-> Alias sch1
-> Definition
db (SetSchema sch0 sch1 schema0 schema1 ty 'Typedef td db)
alterTypeSetSchema QualifiedAlias sch0 ty
ty Alias sch1
sch = ByteString
-> Definition
db
(Alter
sch1
(Create ty ('Typedef td) schema1)
(Alter sch0 (DropSchemum ty 'Typedef schema0) db))
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
-> Definition
db
(Alter
sch1
(Create ty ('Typedef td) schema1)
(Alter sch0 (DropSchemum ty 'Typedef schema0) db)))
-> ByteString
-> Definition
db
(Alter
sch1
(Create ty ('Typedef td) schema1)
(Alter sch0 (DropSchemum ty 'Typedef schema0) db))
forall a b. (a -> b) -> a -> b
$
ByteString
"ALTER TYPE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch0 ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch0 ty
ty ByteString -> ByteString -> ByteString
<+> ByteString
"SET SCHEMA" ByteString -> ByteString -> ByteString
<+> Alias sch1 -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias sch1
sch ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"