520e294 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

more sql types

520e294Eitan Chatav9 years ago

README.md+1−1

compare with dev

unifiedsplit

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

132 createTable #emails

133 ( serial `As` #id :*

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

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

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

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

137 foreignKey #user_id #users #id

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

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

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

52 createTable #emails

53 ( serial `As` #id :*

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

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

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

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

57 foreignKey #user_id #users #id

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

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

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

71-- createTable #emails

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

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

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

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

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

76-- foreignKey #user_id #users #id

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

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

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

81--

82-- >>> 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);"

84--

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

86-- 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

67 -- * Views

68 , createView

69 , dropView

70+ , createTypeEnum

71+ , ColumnTypeExpression (..)

72+ , notNull

73+ , null'

74+ , default_

75+ , serial2

76+ , smallserial

77+ , serial4

78+ , serial

79+ , serial8

80+ , bigserial

70 ) where

81 ) where

72import Control.Category

83import Control.Category

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

111-- >>> :set -XOverloadedLabels

122-- >>> :set -XOverloadedLabels

112-- >>> :{

123-- >>> :{

113-- renderDefinition $

124-- 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

115-- :}

126-- :}

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

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

117createTable

128createTable

118 :: ( KnownSymbol table

129 :: ( KnownSymbol table

119 , columns ~ (col ': cols)

130 , columns ~ (col ': cols)

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

121 , SOP.SListI constraints

132 , SOP.SListI constraints

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

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

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

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

124− -> NP (Aliased TypeExpression) columns

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

125 -- ^ the names and datatype of each column

136 -- ^ the names and datatype of each column

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

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

127 -- ^ constraints that must hold for the table

138 -- ^ constraints that must hold for the table

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

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

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

139-- >>> :{

150-- >>> :{

140-- renderDefinition

151-- 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)

142-- :}

153-- :}

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

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

144createTableIfNotExists

155createTableIfNotExists

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

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

146 , SOP.SListI columns

157 , SOP.SListI columns

147 , SOP.SListI constraints )

158 , SOP.SListI constraints )

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

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

149− -> NP (Aliased TypeExpression) columns

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

150 -- ^ the names and datatype of each column

161 -- ^ the names and datatype of each column

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

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

152 -- ^ constraints that must hold for the table

163 -- ^ constraints that must hold for the table

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

161 , SOP.SListI columns

172 , SOP.SListI columns

162 , SOP.SListI constraints )

173 , SOP.SListI constraints )

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

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

164− -> NP (Aliased TypeExpression) columns

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

165 -- ^ the names and datatype of each column

176 -- ^ the names and datatype of each column

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

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

167 -- ^ constraints that must hold for the table

178 -- ^ constraints that must hold for the table

168 -> ByteString

179 -> ByteString

169renderCreation tab columns constraints = renderAlias tab

180renderCreation tab columns constraints = renderAlias tab

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

175 renderCommaSeparated renderConstraint constraints ) )

186 renderCommaSeparated renderConstraint constraints ) )

176 <> ";"

187 <> ";"

177 where

188 where

178− renderColumnDef :: Aliased TypeExpression x -> ByteString

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

179 renderColumnDef (ty `As` column) =

190 renderColumnDef (ty `As` column) =

180− renderAlias column <+> renderTypeExpression ty

191+ renderAlias column <+> renderColumnTypeExpression ty

181 renderConstraint

192 renderConstraint

182 :: Aliased (TableConstraintExpression schema columns) constraint

193 :: Aliased (TableConstraintExpression schema columns) constraint

183 -> ByteString

194 -> ByteString

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

251-- let

262-- let

252-- definition :: Definition '[] Schema

263-- definition :: Definition '[] Schema

253-- definition = createTable #tab

264-- definition = createTable #tab

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

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

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

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

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

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

257-- :}

268-- :}

258--

269--

259-- >>> renderDefinition definition

270-- >>> 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\"));"

261unique

272unique

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

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

263 , HasAll aliases (TableToColumns table) subcolumns )

274 , HasAll aliases (TableToColumns table) subcolumns )

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

332-- createTable #emails

343-- createTable #emails

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

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

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

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

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

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

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

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

337-- foreignKey #user_id #users #id

348-- foreignKey #user_id #users #id

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

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

339-- in renderDefinition setup

350-- in renderDefinition setup

340-- :}

351-- :}

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);"

342--

353--

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

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

344--

355--

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

362-- createTable #employees

373-- createTable #employees

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

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

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

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

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

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

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

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

367-- foreignKey #employer_id #employees #id

378-- foreignKey #employer_id #employees #id

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

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

369-- in renderDefinition setup

380-- in renderDefinition setup

370-- :}

381-- :}

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);"

372--

383--

373foreignKey

384foreignKey

374 :: (ForeignKeyed schema child parent

385 :: (ForeignKeyed schema child parent

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

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

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

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

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

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

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

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

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

568 -- in renderDefinition definition

579 -- in renderDefinition definition

569 -- :}

580 -- :}

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

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

571 --

582 --

572 -- >>> :{

583 -- >>> :{

573 -- let

584 -- let

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

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

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

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

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

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

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

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

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

580 -- in renderDefinition definition

591 -- in renderDefinition definition

581 -- :}

592 -- :}

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

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

583 addColumn

594 addColumn

584 :: ( KnownSymbol column

595 :: ( KnownSymbol column

585 , Has tab schema ('Table table0)

596 , Has tab schema ('Table table0)

586 , table0 ~ (constraints :=> columns)

597 , table0 ~ (constraints :=> columns)

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

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

588 => Alias column -- ^ column to add

599 => Alias column -- ^ column to add

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

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

590 -> AlterTable tab table1 schema

601 -> AlterTable tab table1 schema

591 addColumn column ty = UnsafeAlterTable $

602 addColumn column ty = UnsafeAlterTable $

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

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

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

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

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

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

595

606

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

650 , Has column columns ty0

661 , Has column columns ty0

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

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

652 => Alias column -- ^ column to alter

663 => Alias column -- ^ column to alter

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

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

654 -> AlterTable tab table1 schema

665 -> AlterTable tab table1 schema

655alterColumn column alteration = UnsafeAlterTable $

666alterColumn column alteration = UnsafeAlterTable $

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

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

657

668

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

669-- | 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) =

660 UnsafeAlterColumn {renderAlterColumn :: ByteString}

671 UnsafeAlterColumn {renderAlterColumn :: ByteString}

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

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

662

673

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

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

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

676setDefault

687setDefault

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

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

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

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

679setDefault expression = UnsafeAlterColumn $

690setDefault expression = UnsafeAlterColumn $

680 "SET DEFAULT" <+> renderExpression expression

691 "SET DEFAULT" <+> renderExpression expression

681

692

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

690-- in renderDefinition definition

701-- in renderDefinition definition

691-- :}

702-- :}

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

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

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

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

694dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

705dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

695

706

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

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

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

707-- :}

718-- :}

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

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

709setNotNull

720setNotNull

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

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

711setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

722setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

712

723

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

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

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

722-- :}

733-- :}

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

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

724dropNotNull

735dropNotNull

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

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

726dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

737dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

727

738

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

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

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

739-- in renderDefinition definition

750-- in renderDefinition definition

740-- :}

751-- :}

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

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

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

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

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

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

744

755

745-- | create a view...

756-- | create a view...

746-- >>> :{

757-- >>> :{

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

769 => Alias view -- ^ view to remove

780 => Alias view -- ^ view to remove

770 -> Definition schema (Drop view schema)

781 -> Definition schema (Drop view schema)

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

782dropView 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

116 , real

117 , float8

118 , doublePrecision

119− , serial2

120− , smallserial

121− , serial4

122− , serial

123− , serial8

124− , bigserial

125 , text

119 , text

126 , char

120 , char

127 , character

121 , character

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

140 , jsonb

134 , jsonb

141 , vararray

135 , vararray

142 , fixarray

136 , fixarray

143− , notNull

144− , default_

145 -- * Re-export

137 -- * Re-export

146 , (&)

138 , (&)

147 , NP ((:*), Nil)

139 , NP ((:*), Nil)

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

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

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

453-- "(TRUE :: int4)"

445-- "(TRUE :: int4)"

454cast

446cast

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

447+ :: TypeExpression ty1

456 -- ^ type to cast as

448 -- ^ type to cast as

457 -> Expression relations grouping params (nullity ty0)

449 -> Expression relations grouping params (nullity ty0)

458 -- ^ value to convert

450 -- ^ value to convert

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

1054-----------------------------------------}

1046-----------------------------------------}

1055

1047

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

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

1057−newtype TypeExpression (ty :: ColumnType)

1049+newtype TypeExpression (ty :: PGType)

1058 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1050 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

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

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

1060

1052

1061-- | logical Boolean (true/false)

1053-- | logical Boolean (true/false)

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

1054+bool :: TypeExpression 'PGbool

1063bool = UnsafeTypeExpression "bool"

1055bool = UnsafeTypeExpression "bool"

1064-- | signed two-byte integer

1056-- | signed two-byte integer

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

1057+int2, smallint :: TypeExpression 'PGint2

1066int2 = UnsafeTypeExpression "int2"

1058int2 = UnsafeTypeExpression "int2"

1067smallint = UnsafeTypeExpression "smallint"

1059smallint = UnsafeTypeExpression "smallint"

1068-- | signed four-byte integer

1060-- | signed four-byte integer

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

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

1070int4 = UnsafeTypeExpression "int4"

1062int4 = UnsafeTypeExpression "int4"

1071int = UnsafeTypeExpression "int"

1063int = UnsafeTypeExpression "int"

1072integer = UnsafeTypeExpression "integer"

1064integer = UnsafeTypeExpression "integer"

1073-- | signed eight-byte integer

1065-- | signed eight-byte integer

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

1066+int8, bigint :: TypeExpression 'PGint8

1075int8 = UnsafeTypeExpression "int8"

1067int8 = UnsafeTypeExpression "int8"

1076bigint = UnsafeTypeExpression "bigint"

1068bigint = UnsafeTypeExpression "bigint"

1077-- | arbitrary precision numeric type

1069-- | arbitrary precision numeric type

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

1070+numeric :: TypeExpression 'PGnumeric

1079numeric = UnsafeTypeExpression "numeric"

1071numeric = UnsafeTypeExpression "numeric"

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

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

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

1073+float4, real :: TypeExpression 'PGfloat4

1082float4 = UnsafeTypeExpression "float4"

1074float4 = UnsafeTypeExpression "float4"

1083real = UnsafeTypeExpression "real"

1075real = UnsafeTypeExpression "real"

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

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

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

1077+float8, doublePrecision :: TypeExpression 'PGfloat8

1086float8 = UnsafeTypeExpression "float8"

1078float8 = UnsafeTypeExpression "float8"

1087doublePrecision = UnsafeTypeExpression "double precision"

1079doublePrecision = 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"

1106-- | variable-length character string

1080-- | variable-length character string

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

1081+text :: TypeExpression 'PGtext

1108text = UnsafeTypeExpression "text"

1082text = UnsafeTypeExpression "text"

1109-- | fixed-length character string

1083-- | fixed-length character string

1110char, character

1084char, character

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

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

1112 => proxy n

1086 => proxy n

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

1087+ -> TypeExpression ('PGchar n)

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

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

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

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

1116-- | variable-length character string

1090-- | variable-length character string

1117varchar, characterVarying

1091varchar, characterVarying

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

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

1119 => proxy n

1093 => proxy n

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

1094+ -> TypeExpression ('PGvarchar n)

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

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

1122characterVarying p = UnsafeTypeExpression $

1096characterVarying p = UnsafeTypeExpression $

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

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

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

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

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

1099+bytea :: TypeExpression 'PGbytea

1126bytea = UnsafeTypeExpression "bytea"

1100bytea = UnsafeTypeExpression "bytea"

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

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

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

1102+timestamp :: TypeExpression 'PGtimestamp

1129timestamp = UnsafeTypeExpression "timestamp"

1103timestamp = UnsafeTypeExpression "timestamp"

1130-- | date and time, including time zone

1104-- | date and time, including time zone

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

1105+timestampWithTimeZone :: TypeExpression 'PGtimestamptz

1132timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

1106timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

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

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

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

1108+date :: TypeExpression 'PGdate

1135date = UnsafeTypeExpression "date"

1109date = UnsafeTypeExpression "date"

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

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

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

1111+time :: TypeExpression 'PGtime

1138time = UnsafeTypeExpression "time"

1112time = UnsafeTypeExpression "time"

1139-- | time of day, including time zone

1113-- | time of day, including time zone

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

1114+timeWithTimeZone :: TypeExpression 'PGtimetz

1141timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1115timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1142-- | time span

1116-- | time span

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

1117+interval :: TypeExpression 'PGinterval

1144interval = UnsafeTypeExpression "interval"

1118interval = UnsafeTypeExpression "interval"

1145-- | universally unique identifier

1119-- | universally unique identifier

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

1120+uuid :: TypeExpression 'PGuuid

1147uuid = UnsafeTypeExpression "uuid"

1121uuid = UnsafeTypeExpression "uuid"

1148-- | IPv4 or IPv6 host address

1122-- | IPv4 or IPv6 host address

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

1123+inet :: TypeExpression 'PGinet

1150inet = UnsafeTypeExpression "inet"

1124inet = UnsafeTypeExpression "inet"

1151-- | textual JSON data

1125-- | textual JSON data

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

1126+json :: TypeExpression 'PGjson

1153json = UnsafeTypeExpression "json"

1127json = UnsafeTypeExpression "json"

1154-- | binary JSON data, decomposed

1128-- | binary JSON data, decomposed

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

1129+jsonb :: TypeExpression 'PGjsonb

1156jsonb = UnsafeTypeExpression "jsonb"

1130jsonb = UnsafeTypeExpression "jsonb"

1157-- | variable length array

1131-- | variable length array

1158vararray

1132vararray

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

1133+ :: TypeExpression pg

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

1134+ -> TypeExpression ('PGvararray pg)

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

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

1162-- | fixed length array

1136-- | fixed length array

1163--

1137--

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

1166fixarray

1140fixarray

1167 :: KnownNat n

1141 :: KnownNat n

1168 => proxy n

1142 => proxy n

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

1143+ -> TypeExpression pg

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

1144+ -> TypeExpression ('PGfixarray n pg)

1171fixarray p ty = UnsafeTypeExpression $

1145fixarray p ty = UnsafeTypeExpression $

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

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

1173

1147

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−

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

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

1190−class PGTyped (ty :: PGType) where

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

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

1192instance PGTyped 'PGbool where pgtype = bool

1150instance PGTyped 'PGbool where pgtype = bool

1193instance PGTyped 'PGint2 where pgtype = int2

1151instance PGTyped 'PGint2 where pgtype = int2

1194instance PGTyped 'PGint4 where pgtype = int4

1152instance PGTyped 'PGint4 where pgtype = int4

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

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

53 createTable #emails

54 ( serial `As` #id :*

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

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

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

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

58 foreignKey #user_id #users #id

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

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

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

150 | PGjsonb -- ^ binary JSON data, decomposed

151 | PGvararray PGType -- ^ variable length array

152 | PGfixarray Nat PGType -- ^ fixed length array

153+ | PGenum [Symbol]

154+ | PGcomposite [(Symbol, PGType)]

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

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

154

156

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

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

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

619data SchemumType

621data SchemumType

620 = Table TableType

622 = Table TableType

621 | View RelationType

623 | View RelationType

624+ | Typedef PGType

622

625

623type SchemaType = [(Symbol,SchemumType)]

626type SchemaType = [(Symbol,SchemumType)]

624

627