520e294 · squeal · git.iko.soy

git.iko.soy/squeal

more sql types

types * Add `PGenum` and `PGcomposite` types * Add `Typedef` schemum * `createTypeEnum` statements * Split `ColumnTypeExpression` from `TypeExpression`

commit520e294684578ac733e9a5da42077482e56b64d2 authorEitan Chatav <eitan.chatav@gmail.com> dateTue 10 Apr 2018, 15:31 (9 years ago) parent875f8f8

7 files changed+135−106

compare with dev

unifiedsplit

README.md+1−1 squeal-postgresql/exe/Example.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+99−31 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+28−70 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+3

README.md+1−1

@@ -132,7 +132,7 @@ let

132132 createTable #emails

133133 ( serial `As` #id :*

134134 (int & notNull) `As` #user_id :*

135− text `As` #email :* Nil )

135+ (text & null') `As` #email :* Nil )

136136 ( primaryKey #id `As` #pk_emails :*

137137 foreignKey #user_id #users #id

138138 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

squeal-postgresql/exe/Example.hs+1−1

@@ -52,7 +52,7 @@ setup =

5252 createTable #emails

5353 ( serial `As` #id :*

5454 (int & notNull) `As` #user_id :*

55− text `As` #email :* Nil )

55+ (text & null') `As` #email :* Nil )

5656 ( primaryKey #id `As` #pk_emails :*

5757 foreignKey #user_id #users #id

5858 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

squeal-postgresql/src/Squeal/PostgreSQL.hs+2−2

@@ -71,7 +71,7 @@

7171-- createTable #emails

7272-- ( serial `As` #id :*

7373-- (int & notNull) `As` #user_id :*

74−-- text `As` #email :* Nil )

74+-- (text & null') `As` #email :* Nil )

7575-- ( primaryKey #id `As` #pk_emails :*

7676-- foreignKey #user_id #users #id

7777-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

@@ -80,7 +80,7 @@

8080-- We can easily see the generated SQL is unsuprising looking.

8181--

8282-- >>> renderDefinition setup

83−-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

83+-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text NULL, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

8484--

8585-- Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.

8686-- In our `createTable` commands we included `TableConstraint`s to define

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+99−31

@@ -67,6 +67,17 @@ module Squeal.PostgreSQL.Definition

6767 -- * Views

6868 , createView

6969 , dropView

70+ , createTypeEnum

71+ , ColumnTypeExpression (..)

72+ , notNull

73+ , null'

74+ , default_

75+ , serial2

76+ , smallserial

77+ , serial4

78+ , serial

79+ , serial8

80+ , bigserial

7081 ) where

7182

7283import Control.Category

@@ -111,9 +122,9 @@ CREATE statements

111122-- >>> :set -XOverloadedLabels

112123-- >>> :{

113124-- renderDefinition $

114−-- createTable #tab (int `As` #a :* real `As` #b :* Nil) Nil

125+-- createTable #tab ((int & null') `As` #a :* (real & null') `As` #b :* Nil) Nil

115126-- :}

116−-- "CREATE TABLE \"tab\" (\"a\" int, \"b\" real);"

127+-- "CREATE TABLE \"tab\" (\"a\" int NULL, \"b\" real NULL);"

117128createTable

118129 :: ( KnownSymbol table

119130 , columns ~ (col ': cols)

@@ -121,7 +132,7 @@ createTable

121132 , SOP.SListI constraints

122133 , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )

123134 => Alias table -- ^ the name of the table to add

124− -> NP (Aliased TypeExpression) columns

135+ -> NP (Aliased (ColumnTypeExpression schema0)) columns

125136 -- ^ the names and datatype of each column

126137 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints

127138 -- ^ constraints that must hold for the table

@@ -138,15 +149,15 @@ createTable tab columns constraints = UnsafeDefinition $

138149-- >>> type Schema = '["tab" ::: 'Table Table]

139150-- >>> :{

140151-- renderDefinition

141−-- (createTableIfNotExists #tab (int `As` #a :* real `As` #b :* Nil) Nil :: Definition Schema Schema)

152+-- (createTableIfNotExists #tab ((int & null') `As` #a :* (real & null') `As` #b :* Nil) Nil :: Definition Schema Schema)

142153-- :}

143−-- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int, \"b\" real);"

154+-- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int NULL, \"b\" real NULL);"

144155createTableIfNotExists

145156 :: ( Has table schema ('Table (constraints :=> columns))

146157 , SOP.SListI columns

147158 , SOP.SListI constraints )

148159 => Alias table -- ^ the name of the table to add

149− -> NP (Aliased TypeExpression) columns

160+ -> NP (Aliased (ColumnTypeExpression schema)) columns

150161 -- ^ the names and datatype of each column

151162 -> NP (Aliased (TableConstraintExpression schema table)) constraints

152163 -- ^ constraints that must hold for the table

@@ -161,9 +172,9 @@ renderCreation

161172 , SOP.SListI columns

162173 , SOP.SListI constraints )

163174 => Alias table -- ^ the name of the table to add

164− -> NP (Aliased TypeExpression) columns

175+ -> NP (Aliased (ColumnTypeExpression schema0)) columns

165176 -- ^ the names and datatype of each column

166− -> NP (Aliased (TableConstraintExpression schema table)) constraints

177+ -> NP (Aliased (TableConstraintExpression schema1 table)) constraints

167178 -- ^ constraints that must hold for the table

168179 -> ByteString

169180renderCreation tab columns constraints = renderAlias tab

@@ -175,9 +186,9 @@ renderCreation tab columns constraints = renderAlias tab

175186 renderCommaSeparated renderConstraint constraints ) )

176187 <> ";"

177188 where

178− renderColumnDef :: Aliased TypeExpression x -> ByteString

189+ renderColumnDef :: Aliased (ColumnTypeExpression schema) x -> ByteString

179190 renderColumnDef (ty `As` column) =

180− renderAlias column <+> renderTypeExpression ty

191+ renderAlias column <+> renderColumnTypeExpression ty

181192 renderConstraint

182193 :: Aliased (TableConstraintExpression schema columns) constraint

183194 -> ByteString

@@ -251,13 +262,13 @@ check _cols condition = UnsafeTableConstraintExpression $

251262-- let

252263-- definition :: Definition '[] Schema

253264-- definition = createTable #tab

254−-- ( int `As` #a :*

255−-- int `As` #b :* Nil )

265+-- ( (int & null') `As` #a :*

266+-- (int & null') `As` #b :* Nil )

256267-- ( unique (#a :* #b :* Nil) `As` #uq_a_b :* Nil )

257268-- :}

258269--

259270-- >>> renderDefinition definition

260−-- "CREATE TABLE \"tab\" (\"a\" int, \"b\" int, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"

271+-- "CREATE TABLE \"tab\" (\"a\" int NULL, \"b\" int NULL, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"

261272unique

262273 :: ( Has alias schema ('Table table)

263274 , HasAll aliases (TableToColumns table) subcolumns )

@@ -332,13 +343,13 @@ primaryKey columns = UnsafeTableConstraintExpression $

332343-- createTable #emails

333344-- ( serial `As` #id :*

334345-- (int & notNull) `As` #user_id :*

335−-- text `As` #email :* Nil )

346+-- (text & null') `As` #email :* Nil )

336347-- ( primaryKey #id `As` #pk_emails :*

337348-- foreignKey #user_id #users #id

338349-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

339350-- in renderDefinition setup

340351-- :}

341−-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

352+-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text NULL, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

342353--

343354-- A `foreignKey` can even be a table self-reference.

344355--

@@ -362,13 +373,13 @@ primaryKey columns = UnsafeTableConstraintExpression $

362373-- createTable #employees

363374-- ( serial `As` #id :*

364375-- (text & notNull) `As` #name :*

365−-- integer `As` #employer_id :* Nil )

376+-- (integer & null') `As` #employer_id :* Nil )

366377-- ( primaryKey #id `As` #employees_pk :*

367378-- foreignKey #employer_id #employees #id

368379-- OnDeleteCascade OnUpdateCascade `As` #employees_employer_fk :* Nil )

369380-- in renderDefinition setup

370381-- :}

371−-- "CREATE TABLE \"employees\" (\"id\" serial, \"name\" text NOT NULL, \"employer_id\" integer, CONSTRAINT \"employees_pk\" PRIMARY KEY (\"id\"), CONSTRAINT \"employees_employer_fk\" FOREIGN KEY (\"employer_id\") REFERENCES \"employees\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

382+-- "CREATE TABLE \"employees\" (\"id\" serial, \"name\" text NOT NULL, \"employer_id\" integer NULL, CONSTRAINT \"employees_pk\" PRIMARY KEY (\"id\"), CONSTRAINT \"employees_employer_fk\" FOREIGN KEY (\"employer_id\") REFERENCES \"employees\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

372383--

373384foreignKey

374385 :: (ForeignKeyed schema child parent

@@ -564,10 +575,10 @@ class AddColumn ty where

564575 -- '["tab" ::: 'Table ('[] :=>

565576 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

566577 -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]

567− -- definition = alterTable #tab (addColumn #col2 (text & default_ "foo"))

578+ -- definition = alterTable #tab (addColumn #col2 (text & null' & default_ "foo"))

568579 -- in renderDefinition definition

569580 -- :}

570− -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text DEFAULT E'foo';"

581+ -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text NULL DEFAULT E'foo';"

571582 --

572583 -- >>> :{

573584 -- let

@@ -576,20 +587,20 @@ class AddColumn ty where

576587 -- '["tab" ::: 'Table ('[] :=>

577588 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

578589 -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]

579− -- definition = alterTable #tab (addColumn #col2 text)

590+ -- definition = alterTable #tab (addColumn #col2 (text & null'))

580591 -- in renderDefinition definition

581592 -- :}

582− -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"

593+ -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text NULL;"

583594 addColumn

584595 :: ( KnownSymbol column

585596 , Has tab schema ('Table table0)

586597 , table0 ~ (constraints :=> columns)

587598 , table1 ~ (constraints :=> Create column ty columns) )

588599 => Alias column -- ^ column to add

589− -> TypeExpression ty -- ^ type of the new column

600+ -> ColumnTypeExpression schema ty -- ^ type of the new column

590601 -> AlterTable tab table1 schema

591602 addColumn column ty = UnsafeAlterTable $

592− "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

603+ "ADD COLUMN" <+> renderAlias column <+> renderColumnTypeExpression ty

593604instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)

594605instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)

595606

@@ -650,13 +661,13 @@ alterColumn

650661 , Has column columns ty0

651662 , tables1 ~ (constraints :=> Alter column ty1 columns))

652663 => Alias column -- ^ column to alter

653− -> AlterColumn ty0 ty1 -- ^ alteration to perform

664+ -> AlterColumn schema ty0 ty1 -- ^ alteration to perform

654665 -> AlterTable tab table1 schema

655666alterColumn column alteration = UnsafeAlterTable $

656667 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

657668

658669-- | An `AlterColumn` describes the alteration to perform on a single column.

659−newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

670+newtype AlterColumn (schema :: SchemaType) (ty0 :: ColumnType) (ty1 :: ColumnType) =

660671 UnsafeAlterColumn {renderAlterColumn :: ByteString}

661672 deriving (GHC.Generic,Show,Eq,Ord,NFData)

662673

@@ -675,7 +686,7 @@ newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

675686-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" SET DEFAULT 5;"

676687setDefault

677688 :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set

678− -> AlterColumn (constraint :=> ty) ('Def :=> ty)

689+ -> AlterColumn schema (constraint :=> ty) ('Def :=> ty)

679690setDefault expression = UnsafeAlterColumn $

680691 "SET DEFAULT" <+> renderExpression expression

681692

@@ -690,7 +701,7 @@ setDefault expression = UnsafeAlterColumn $

690701-- in renderDefinition definition

691702-- :}

692703-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" DROP DEFAULT;"

693−dropDefault :: AlterColumn ('Def :=> ty) ('NoDef :=> ty)

704+dropDefault :: AlterColumn schema ('Def :=> ty) ('NoDef :=> ty)

694705dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

695706

696707-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.

@@ -707,7 +718,7 @@ dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

707718-- :}

708719-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" SET NOT NULL;"

709720setNotNull

710− :: AlterColumn (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)

721+ :: AlterColumn schema (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)

711722setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

712723

713724-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.

@@ -722,7 +733,7 @@ setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

722733-- :}

723734-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" DROP NOT NULL;"

724735dropNotNull

725− :: AlterColumn (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)

736+ :: AlterColumn schema (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)

726737dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

727738

728739-- | An `alterType` converts a column to a different data type.

@@ -739,8 +750,8 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

739750-- in renderDefinition definition

740751-- :}

741752-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" TYPE numeric NOT NULL;"

742−alterType :: TypeExpression ty -> AlterColumn ty0 ty

743−alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderTypeExpression ty

753+alterType :: ColumnTypeExpression schema ty -> AlterColumn schema ty0 ty

754+alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty

744755

745756-- | create a view...

746757-- >>> :{

@@ -769,3 +780,60 @@ dropView

769780 => Alias view -- ^ view to remove

770781 -> Definition schema (Drop view schema)

771782dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"

783+

784+createTypeEnum

785+ :: (KnownSymbol enum, SOP.All KnownSymbol labels)

786+ => Alias enum

787+ -> NP Alias labels

788+ -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)

789+createTypeEnum enum labels = UnsafeDefinition $

790+ "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>

791+ parenthesized (commaSeparated (renderAliases labels)) <> ";"

792+

793+-- | `ColumnTypeExpression`s are used in `createTable` commands.

794+newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)

795+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

796+ deriving (GHC.Generic,Show,Eq,Ord,NFData)

797+

798+instance (Has alias schema ('Typedef ty))

799+ => IsLabel alias (ColumnTypeExpression schema ('NoDef :=> 'NotNull ty)) where

800+ fromLabel = UnsafeColumnTypeExpression (renderAlias (fromLabel @alias))

801+

802+null'

803+ :: TypeExpression ty

804+ -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

805+null' ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

806+

807+-- | used in `createTable` commands as a column constraint to ensure

808+-- @NULL@ is not present

809+notNull

810+ :: TypeExpression ty

811+ -> ColumnTypeExpression schema (def :=> 'NotNull ty)

812+notNull ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

813+

814+-- | used in `createTable` commands as a column constraint to give a default

815+default_

816+ :: Expression '[] 'Ungrouped '[] ty

817+ -> ColumnTypeExpression schema ('NoDef :=> ty)

818+ -> ColumnTypeExpression schema ('Def :=> ty)

819+default_ x ty = UnsafeColumnTypeExpression $

820+ renderColumnTypeExpression ty <+> "DEFAULT" <+> renderExpression x

821+

822+-- | not a true type, but merely a notational convenience for creating

823+-- unique identifier columns with type `'PGint2`

824+serial2, smallserial

825+ :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint2)

826+serial2 = UnsafeColumnTypeExpression "serial2"

827+smallserial = UnsafeColumnTypeExpression "smallserial"

828+-- | not a true type, but merely a notational convenience for creating

829+-- unique identifier columns with type `'PGint4`

830+serial4, serial

831+ :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint4)

832+serial4 = UnsafeColumnTypeExpression "serial4"

833+serial = UnsafeColumnTypeExpression "serial"

834+-- | not a true type, but merely a notational convenience for creating

835+-- unique identifier columns with type `'PGint8`

836+serial8, bigserial

837+ :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint8)

838+serial8 = UnsafeColumnTypeExpression "serial8"

839+bigserial = UnsafeColumnTypeExpression "bigserial"

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+28−70

@@ -116,12 +116,6 @@ module Squeal.PostgreSQL.Expression

116116 , real

117117 , float8

118118 , doublePrecision

119− , serial2

120− , smallserial

121− , serial4

122− , serial

123− , serial8

124− , bigserial

125119 , text

126120 , char

127121 , character

@@ -140,8 +134,6 @@ module Squeal.PostgreSQL.Expression

140134 , jsonb

141135 , vararray

142136 , fixarray

143− , notNull

144− , default_

145137 -- * Re-export

146138 , (&)

147139 , NP ((:*), Nil)

@@ -452,7 +444,7 @@ atan2_ y x = UnsafeExpression $

452444-- | >>> renderExpression $ true & cast int4

453445-- "(TRUE :: int4)"

454446cast

455− :: TypeExpression ('NoDef :=> 'Null ty1)

447+ :: TypeExpression ty1

456448 -- ^ type to cast as

457449 -> Expression relations grouping params (nullity ty0)

458450 -- ^ value to convert

@@ -1054,110 +1046,92 @@ type expressions

10541046-----------------------------------------}

10551047

10561048-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1057−newtype TypeExpression (ty :: ColumnType)

1049+newtype TypeExpression (ty :: PGType)

10581050 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

10591051 deriving (GHC.Generic,Show,Eq,Ord,NFData)

10601052

10611053-- | logical Boolean (true/false)

1062−bool :: TypeExpression ('NoDef :=> 'Null 'PGbool)

1054+bool :: TypeExpression 'PGbool

10631055bool = UnsafeTypeExpression "bool"

10641056-- | signed two-byte integer

1065−int2, smallint :: TypeExpression ('NoDef :=> 'Null 'PGint2)

1057+int2, smallint :: TypeExpression 'PGint2

10661058int2 = UnsafeTypeExpression "int2"

10671059smallint = UnsafeTypeExpression "smallint"

10681060-- | signed four-byte integer

1069−int4, int, integer :: TypeExpression ('NoDef :=> 'Null 'PGint4)

1061+int4, int, integer :: TypeExpression 'PGint4

10701062int4 = UnsafeTypeExpression "int4"

10711063int = UnsafeTypeExpression "int"

10721064integer = UnsafeTypeExpression "integer"

10731065-- | signed eight-byte integer

1074−int8, bigint :: TypeExpression ('NoDef :=> 'Null 'PGint8)

1066+int8, bigint :: TypeExpression 'PGint8

10751067int8 = UnsafeTypeExpression "int8"

10761068bigint = UnsafeTypeExpression "bigint"

10771069-- | arbitrary precision numeric type

1078−numeric :: TypeExpression ('NoDef :=> 'Null 'PGnumeric)

1070+numeric :: TypeExpression 'PGnumeric

10791071numeric = UnsafeTypeExpression "numeric"

10801072-- | single precision floating-point number (4 bytes)

1081−float4, real :: TypeExpression ('NoDef :=> 'Null 'PGfloat4)

1073+float4, real :: TypeExpression 'PGfloat4

10821074float4 = UnsafeTypeExpression "float4"

10831075real = UnsafeTypeExpression "real"

10841076-- | double precision floating-point number (8 bytes)

1085−float8, doublePrecision :: TypeExpression ('NoDef :=> 'Null 'PGfloat8)

1077+float8, doublePrecision :: TypeExpression 'PGfloat8

10861078float8 = UnsafeTypeExpression "float8"

10871079doublePrecision = UnsafeTypeExpression "double precision"

1088−-- | not a true type, but merely a notational convenience for creating

1089−-- unique identifier columns with type `'PGint2`

1090−serial2, smallserial

1091− :: TypeExpression ('Def :=> 'NotNull 'PGint2)

1092−serial2 = UnsafeTypeExpression "serial2"

1093−smallserial = UnsafeTypeExpression "smallserial"

1094−-- | not a true type, but merely a notational convenience for creating

1095−-- unique identifier columns with type `'PGint4`

1096−serial4, serial

1097− :: TypeExpression ('Def :=> 'NotNull 'PGint4)

1098−serial4 = UnsafeTypeExpression "serial4"

1099−serial = UnsafeTypeExpression "serial"

1100−-- | not a true type, but merely a notational convenience for creating

1101−-- unique identifier columns with type `'PGint8`

1102−serial8, bigserial

1103− :: TypeExpression ('Def :=> 'NotNull 'PGint8)

1104−serial8 = UnsafeTypeExpression "serial8"

1105−bigserial = UnsafeTypeExpression "bigserial"

11061080-- | variable-length character string

1107−text :: TypeExpression ('NoDef :=> 'Null 'PGtext)

1081+text :: TypeExpression 'PGtext

11081082text = UnsafeTypeExpression "text"

11091083-- | fixed-length character string

11101084char, character

11111085 :: (KnownNat n, 1 <= n)

11121086 => proxy n

1113− -> TypeExpression ('NoDef :=> 'Null ('PGchar n))

1087+ -> TypeExpression ('PGchar n)

11141088char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"

11151089character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"

11161090-- | variable-length character string

11171091varchar, characterVarying

11181092 :: (KnownNat n, 1 <= n)

11191093 => proxy n

1120− -> TypeExpression ('NoDef :=> 'Null ('PGvarchar n))

1094+ -> TypeExpression ('PGvarchar n)

11211095varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"

11221096characterVarying p = UnsafeTypeExpression $

11231097 "character varying(" <> renderNat p <> ")"

11241098-- | binary data ("byte array")

1125−bytea :: TypeExpression ('NoDef :=> 'Null 'PGbytea)

1099+bytea :: TypeExpression 'PGbytea

11261100bytea = UnsafeTypeExpression "bytea"

11271101-- | date and time (no time zone)

1128−timestamp :: TypeExpression ('NoDef :=> 'Null 'PGtimestamp)

1102+timestamp :: TypeExpression 'PGtimestamp

11291103timestamp = UnsafeTypeExpression "timestamp"

11301104-- | date and time, including time zone

1131−timestampWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimestamptz)

1105+timestampWithTimeZone :: TypeExpression 'PGtimestamptz

11321106timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

11331107-- | calendar date (year, month, day)

1134−date :: TypeExpression ('NoDef :=> 'Null 'PGdate)

1108+date :: TypeExpression 'PGdate

11351109date = UnsafeTypeExpression "date"

11361110-- | time of day (no time zone)

1137−time :: TypeExpression ('NoDef :=> 'Null 'PGtime)

1111+time :: TypeExpression 'PGtime

11381112time = UnsafeTypeExpression "time"

11391113-- | time of day, including time zone

1140−timeWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimetz)

1114+timeWithTimeZone :: TypeExpression 'PGtimetz

11411115timeWithTimeZone = UnsafeTypeExpression "time with time zone"

11421116-- | time span

1143−interval :: TypeExpression ('NoDef :=> 'Null 'PGinterval)

1117+interval :: TypeExpression 'PGinterval

11441118interval = UnsafeTypeExpression "interval"

11451119-- | universally unique identifier

1146−uuid :: TypeExpression ('NoDef :=> 'Null 'PGuuid)

1120+uuid :: TypeExpression 'PGuuid

11471121uuid = UnsafeTypeExpression "uuid"

11481122-- | IPv4 or IPv6 host address

1149−inet :: TypeExpression ('NoDef :=> 'Null 'PGinet)

1123+inet :: TypeExpression 'PGinet

11501124inet = UnsafeTypeExpression "inet"

11511125-- | textual JSON data

1152−json :: TypeExpression ('NoDef :=> 'Null 'PGjson)

1126+json :: TypeExpression 'PGjson

11531127json = UnsafeTypeExpression "json"

11541128-- | binary JSON data, decomposed

1155−jsonb :: TypeExpression ('NoDef :=> 'Null 'PGjsonb)

1129+jsonb :: TypeExpression 'PGjsonb

11561130jsonb = UnsafeTypeExpression "jsonb"

11571131-- | variable length array

11581132vararray

1159− :: TypeExpression ('NoDef :=> 'Null pg)

1160− -> TypeExpression ('NoDef :=> 'Null ('PGvararray pg))

1133+ :: TypeExpression pg

1134+ -> TypeExpression ('PGvararray pg)

11611135vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

11621136-- | fixed length array

11631137--

@@ -1166,29 +1140,13 @@ vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

11661140fixarray

11671141 :: KnownNat n

11681142 => proxy n

1169− -> TypeExpression ('NoDef :=> 'Null pg)

1170− -> TypeExpression ('NoDef :=> 'Null ('PGfixarray n pg))

1143+ -> TypeExpression pg

1144+ -> TypeExpression ('PGfixarray n pg)

11711145fixarray p ty = UnsafeTypeExpression $

11721146 renderTypeExpression ty <> "[" <> renderNat p <> "]"

11731147

1174−-- | used in `createTable` commands as a column constraint to ensure

1175−-- @NULL@ is not present

1176−notNull

1177− :: TypeExpression (def :=> 'Null ty)

1178− -> TypeExpression (def :=> 'NotNull ty)

1179−notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

1180−

1181−-- | used in `createTable` commands as a column constraint to give a default

1182−default_

1183− :: Expression '[] 'Ungrouped '[] ty

1184− -> TypeExpression ('NoDef :=> ty)

1185− -> TypeExpression ('Def :=> ty)

1186−default_ x ty = UnsafeTypeExpression $

1187− renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x

1188−

11891148-- | `pgtype` is a demoted version of a `PGType`

1190−class PGTyped (ty :: PGType) where

1191− pgtype :: TypeExpression ('NoDef :=> 'Null ty)

1149+class PGTyped (ty :: PGType) where pgtype :: TypeExpression ty

11921150instance PGTyped 'PGbool where pgtype = bool

11931151instance PGTyped 'PGint2 where pgtype = int2

11941152instance PGTyped 'PGint4 where pgtype = int4

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1−1

@@ -53,7 +53,7 @@ let

5353 createTable #emails

5454 ( serial `As` #id :*

5555 (int & notNull) `As` #user_id :*

56− text `As` #email :* Nil )

56+ (text & null') `As` #email :* Nil )

5757 ( primaryKey #id `As` #pk_emails :*

5858 foreignKey #user_id #users #id

5959 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+3

@@ -150,6 +150,8 @@ data PGType

150150 | PGjsonb -- ^ binary JSON data, decomposed

151151 | PGvararray PGType -- ^ variable length array

152152 | PGfixarray Nat PGType -- ^ fixed length array

153+ | PGenum [Symbol]

154+ | PGcomposite [(Symbol, PGType)]

153155 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

154156

155157-- | The object identifier of a `PGType`.

@@ -619,6 +621,7 @@ type family DropIfConstraintsInvolve column constraints where

619621data SchemumType

620622 = Table TableType

621623 | View RelationType

624+ | Typedef PGType

622625

623626type SchemaType = [(Symbol,SchemumType)]

624627