2c7844e · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

documentation and tests

2c7844eEitan Chatav8 years ago

README.md+3−3

compare with dev

unifiedsplit

@@ -127,12 +127,12 @@ let

127 setup =

128 createTable #users

129 ( serial `As` #id :*

130− (text & hasNotNull) `As` #name :* Nil )

130+ (text & notNullable) `As` #name :* Nil )

131 ( primaryKey #id `As` #pk_users :* Nil ) >>>

132 createTable #emails

133 ( serial `As` #id :*

134− (int & hasNotNull) `As` #user_id :*

134+ (int & notNullable) `As` #user_id :*

135− (text & hasNull) `As` #email :* Nil )

135+ (text & nullable) `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+4−4

@@ -45,14 +45,14 @@ setup :: Definition '[] Schema

45setup =

46 createTable #users

47 ( serial `As` #id :*

48− (text & hasNotNull) `As` #name :*

48+ (text & notNullable) `As` #name :*

49− (vararray int2 & hasNotNull) `As` #vec :* Nil )

49+ (vararray int2 & notNullable) `As` #vec :* Nil )

50 ( primaryKey #id `As` #pk_users :* Nil )

51 >>>

52 createTable #emails

53 ( serial `As` #id :*

54− (int & hasNotNull) `As` #user_id :*

54+ (int & notNullable) `As` #user_id :*

55− (text & hasNull) `As` #email :* Nil )

55+ (text & nullable) `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+3−3

@@ -66,12 +66,12 @@

66-- setup =

67-- createTable #users

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

69−-- (text & hasNotNull) `As` #name :* Nil )

69+-- (text & notNullable) `As` #name :* Nil )

70-- ( primaryKey #id `As` #pk_users :* Nil ) >>>

71-- createTable #emails

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

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

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

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

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

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

76-- foreignKey #user_id #users #id

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

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+92−45

@@ -66,14 +66,15 @@ module Squeal.PostgreSQL.Definition

66 , createView

67 , dropView

68 -- * Types

69− , createTypeComposite

70 , createTypeEnum

69 , createTypeEnum

71− , HasPGcomposite (..)

70+ , createTypeEnumWith

72− , HasPGenum (..)

71+ , createTypeComposite

72+ , createTypeCompositeWith

73 , dropType

74+ -- * Columns

74 , ColumnTypeExpression (..)

75 , ColumnTypeExpression (..)

75− , hasNull

76+ , nullable

76− , hasNotNull

77+ , notNullable

77 , default_

78 , default_

78 , serial2

79 , serial2

79 , smallserial

80 , smallserial

@@ -125,7 +126,7 @@ CREATE statements

125-- >>> :set -XOverloadedLabels

126-- >>> :set -XOverloadedLabels

126-- >>> :{

127-- >>> :{

127-- renderDefinition $

128-- renderDefinition $

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

129+-- createTable #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil

129-- :}

130-- :}

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

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

131createTable

132createTable

@@ -152,7 +153,7 @@ createTable tab columns constraints = UnsafeDefinition $

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

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

153-- >>> :{

154-- >>> :{

154-- renderDefinition

155-- renderDefinition

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

156+-- (createTableIfNotExists #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil :: Definition Schema Schema)

156-- :}

157-- :}

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

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

158createTableIfNotExists

159createTableIfNotExists

@@ -234,8 +235,8 @@ newtype TableConstraintExpression

234-- let

235-- let

235-- definition :: Definition '[] Schema

236-- definition :: Definition '[] Schema

236-- definition = createTable #tab

237-- definition = createTable #tab

237−-- ( (int & hasNotNull) `As` #a :*

238+-- ( (int & notNullable) `As` #a :*

238−-- (int & hasNotNull) `As` #b :* Nil )

239+-- (int & notNullable) `As` #b :* Nil )

239-- ( check (#a :* #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

240-- ( check (#a :* #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

240-- :}

241-- :}

241--

242--

@@ -265,8 +266,8 @@ check _cols condition = UnsafeTableConstraintExpression $

265-- let

266-- let

266-- definition :: Definition '[] Schema

267-- definition :: Definition '[] Schema

267-- definition = createTable #tab

268-- definition = createTable #tab

268−-- ( (int & hasNull) `As` #a :*

269+-- ( (int & nullable) `As` #a :*

269−-- (int & hasNull) `As` #b :* Nil )

270+-- (int & nullable) `As` #b :* Nil )

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

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

271-- :}

272-- :}

272--

273--

@@ -297,7 +298,7 @@ unique columns = UnsafeTableConstraintExpression $

297-- definition :: Definition '[] Schema

298-- definition :: Definition '[] Schema

298-- definition = createTable #tab

299-- definition = createTable #tab

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

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

300−-- (text & hasNotNull) `As` #name :* Nil )

301+-- (text & notNullable) `As` #name :* Nil )

301-- ( primaryKey #id `As` #pk_id :* Nil )

302-- ( primaryKey #id `As` #pk_id :* Nil )

302-- :}

303-- :}

303--

304--

@@ -341,12 +342,12 @@ primaryKey columns = UnsafeTableConstraintExpression $

341-- setup =

342-- setup =

342-- createTable #users

343-- createTable #users

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

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

344−-- (text & hasNotNull) `As` #name :* Nil )

345+-- (text & notNullable) `As` #name :* Nil )

345-- ( primaryKey #id `As` #pk_users :* Nil ) >>>

346-- ( primaryKey #id `As` #pk_users :* Nil ) >>>

346-- createTable #emails

347-- createTable #emails

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

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

348−-- (int & hasNotNull) `As` #user_id :*

349+-- (int & notNullable) `As` #user_id :*

349−-- (text & hasNull) `As` #email :* Nil )

350+-- (text & nullable) `As` #email :* Nil )

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

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

351-- foreignKey #user_id #users #id

352-- foreignKey #user_id #users #id

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

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

@@ -375,8 +376,8 @@ primaryKey columns = UnsafeTableConstraintExpression $

375-- setup =

376-- setup =

376-- createTable #employees

377-- createTable #employees

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

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

378−-- (text & hasNotNull) `As` #name :*

379+-- (text & notNullable) `As` #name :*

379−-- (integer & hasNull) `As` #employer_id :* Nil )

380+-- (integer & nullable) `As` #employer_id :* Nil )

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

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

381-- foreignKey #employer_id #employees #id

382-- foreignKey #employer_id #employees #id

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

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

@@ -409,6 +410,7 @@ foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

409 <+> renderOnDeleteClause ondel

410 <+> renderOnDeleteClause ondel

410 <+> renderOnUpdateClause onupd

411 <+> renderOnUpdateClause onupd

411

412

413+-- | A constraint synonym between types involved in a foreign key constraint.

412type ForeignKeyed schema

414type ForeignKeyed schema

413 child parent

415 child parent

414 table reftable

416 table reftable

@@ -578,7 +580,7 @@ class AddColumn ty where

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

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

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

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

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

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

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

583+ -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))

582 -- in renderDefinition definition

584 -- in renderDefinition definition

583 -- :}

585 -- :}

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

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

@@ -590,7 +592,7 @@ class AddColumn ty where

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

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

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

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

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

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

593− -- definition = alterTable #tab (addColumn #col2 (text & hasNull))

595+ -- definition = alterTable #tab (addColumn #col2 (text & nullable))

594 -- in renderDefinition definition

596 -- in renderDefinition definition

595 -- :}

597 -- :}

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

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

@@ -749,14 +751,15 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

749-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]

751-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]

750-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]

752-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]

751-- definition =

753-- definition =

752−-- alterTable #tab (alterColumn #col (alterType (numeric & hasNotNull)))

754+-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))

753-- in renderDefinition definition

755-- in renderDefinition definition

754-- :}

756-- :}

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

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

756alterType :: ColumnTypeExpression schema ty -> AlterColumn schema ty0 ty

758alterType :: ColumnTypeExpression schema ty -> AlterColumn schema ty0 ty

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

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

758

760

759−-- | create a view...

761+-- | Create a view.

762+--

760-- >>> :{

763-- >>> :{

761-- let

764-- let

762-- definition :: Definition

765-- definition :: Definition

@@ -778,12 +781,28 @@ createView alias query = UnsafeDefinition $

778 "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"

781 "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"

779 <+> renderQuery query <> ";"

782 <+> renderQuery query <> ";"

780

783

784+-- | Drop a view.

785+--

786+-- >>> :{

787+-- let

788+-- definition :: Definition

789+-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])

790+-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]

791+-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]

792+-- definition = dropView #bc

793+-- in renderDefinition definition

794+-- :}

795+-- "DROP VIEW \"bc\";"

781dropView

796dropView

782 :: Has view schema ('View v)

797 :: Has view schema ('View v)

783 => Alias view -- ^ view to remove

798 => Alias view -- ^ view to remove

784 -> Definition schema (Drop view schema)

799 -> Definition schema (Drop view schema)

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

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

786

801

802+-- | Enumerated types are created using the `createTypeEnum` command, for example

803+--

804+-- >>> renderDefinition $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy" :* Nil)

805+-- "CREATE TYPE \"mood\" AS ('sad', 'ok', 'happy');"

787createTypeEnum

806createTypeEnum

788 :: (KnownSymbol enum, SOP.All KnownSymbol labels)

807 :: (KnownSymbol enum, SOP.All KnownSymbol labels)

789 => Alias enum

808 => Alias enum

@@ -793,17 +812,29 @@ createTypeEnum enum labels = UnsafeDefinition $

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

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

794 parenthesized (commaSeparated (renderLabels labels)) <> ";"

813 parenthesized (commaSeparated (renderLabels labels)) <> ";"

795

814

796−class

815+-- | Enumerated types can also be generated from a Haskell type, for example

816+--

817+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

818+-- >>> instance SOP.Generic Schwarma

819+-- >>> instance SOP.HasDatatypeInfo Schwarma

820+-- >>> renderDefinition $ createTypeEnumWith @Schwarma #schwarma

821+-- "CREATE TYPE \"schwarma\" AS ('Beef', 'Lamb', 'Chicken');"

822+createTypeEnumWith

823+ :: forall hask enum schema.

797− ( SOP.IsEnumType hask

824+ ( SOP.Generic hask

798 , SOP.All KnownSymbol (LabelsWith hask)

825 , SOP.All KnownSymbol (LabelsWith hask)

799− ) => HasPGenum hask where

800− createTypeEnumWith

801− :: KnownSymbol enum

826+ , KnownSymbol enum

827+ )

802− => Alias enum

828+ => Alias enum

803− -> Definition schema (Create enum ('Typedef (EnumWith hask)) schema)

829+ -> Definition schema (Create enum ('Typedef (EnumWith hask)) schema)

804− createTypeEnumWith enum = createTypeEnum enum

830+createTypeEnumWith enum = createTypeEnum enum

805− (SOP.hpure label :: NP PGlabel (LabelsWith hask))

831+ (SOP.hpure label :: NP PGlabel (LabelsWith hask))

806

832

833+-- | `createTypeComposite` creates a composite type. The composite type is

834+-- specified by a list of attribute names and data types.

835+--

836+-- >>> renderDefinition $ createTypeComposite #complex (float8 `As` #real :* float8 `As` #imaginary :* Nil)

837+-- "CREATE TYPE \"complex\" AS (float8 AS \"real\", float8 AS \"imaginary\");"

807createTypeComposite

838createTypeComposite

808 :: (KnownSymbol ty, SOP.SListI fields)

839 :: (KnownSymbol ty, SOP.SListI fields)

809 => Alias ty

840 => Alias ty

@@ -813,19 +844,33 @@ createTypeComposite ty fields = UnsafeDefinition $

813 "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized

844 "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized

814 (renderCommaSeparated (renderAliasedAs renderTypeExpression) fields) <> ";"

845 (renderCommaSeparated (renderAliasedAs renderTypeExpression) fields) <> ";"

815

846

816−class

847+-- | Composite types can also be generated from a Haskell type, for example

848+--

849+-- >>> data Complex = Complex {real :: Maybe Double, imaginary :: Maybe Double} deriving GHC.Generic

850+-- >>> instance SOP.Generic Complex

851+-- >>> instance SOP.HasDatatypeInfo Complex

852+-- >>> renderDefinition $ createTypeCompositeWith @Complex #complex

853+-- "CREATE TYPE \"complex\" AS (float8 AS \"real\", float8 AS \"imaginary\");"

854+createTypeCompositeWith

855+ :: forall hask ty schema.

817 ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

856 ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

818 , SOP.All PGTyped (FieldTypesWith hask)

857 , SOP.All PGTyped (FieldTypesWith hask)

819− ) => HasPGcomposite hask where

820− createTypeCompositeWith

821− :: KnownSymbol ty

858+ , KnownSymbol ty

859+ )

822− => Alias ty

860+ => Alias ty

823− -> Definition schema (Create ty ( 'Typedef (CompositeWith hask)) schema)

861+ -> Definition schema (Create ty ( 'Typedef (CompositeWith hask)) schema)

824− createTypeCompositeWith ty = createTypeComposite ty $ zipAs

862+createTypeCompositeWith ty = createTypeComposite ty $ zipAs

825− (SOP.hpure Alias :: NP Alias (FieldNamesWith hask))

863+ (SOP.hpure Alias :: NP Alias (FieldNamesWith hask))

826− (SOP.hcpure (SOP.Proxy :: SOP.Proxy PGTyped) pgtype

864+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy PGTyped) pgtype

827− :: NP TypeExpression (FieldTypesWith hask))

865+ :: NP TypeExpression (FieldTypesWith hask))

828

866

867+-- | Drop a type.

868+--

869+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

870+-- >>> instance SOP.Generic Schwarma

871+-- >>> instance SOP.HasDatatypeInfo Schwarma

872+-- >>> renderDefinition (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (EnumWith Schwarma)] '[])

873+-- "DROP TYPE \"schwarma\";"

829dropType

874dropType

830 :: Has tydef schema ('Typedef ty)

875 :: Has tydef schema ('Typedef ty)

831 => Alias tydef

876 => Alias tydef

@@ -841,17 +886,19 @@ instance (Has alias schema ('Typedef ty))

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

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

842 fromLabel = UnsafeColumnTypeExpression (renderAlias (fromLabel @alias))

887 fromLabel = UnsafeColumnTypeExpression (renderAlias (fromLabel @alias))

843

888

844−hasNull

889+-- | used in `createTable` commands as a column constraint to note that

890+-- @NULL@ may be present in a column

891+nullable

845 :: TypeExpression ty

892 :: TypeExpression ty

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

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

847−hasNull ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

894+nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

848

895

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

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

850−-- @NULL@ is not present

897+-- @NULL@ is not present in a column

851−hasNotNull

898+notNullable

852 :: TypeExpression ty

899 :: TypeExpression ty

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

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

854−hasNotNull ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

901+notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

855

902

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

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

857default_

904default_

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

@@ -40,7 +40,7 @@ module Squeal.PostgreSQL.Expression

40 , isNotNull

41 , matchNull

42 , nullIf

43− -- ** Arrays, Enums, Composites

43+ -- ** Collections

44 , array

45 , row

46 -- ** Functions

@@ -366,9 +366,17 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label

366 (Expression relations grouping params (nullity ('PGenum labels))) where

367 label = UnsafeExpression $ renderLabel (PGlabel @label)

368

369+-- | A row constructor is an expression that builds a row value

370+-- (also called a composite value) using values for its member fields.

371+--

372+-- >>> type Complex = PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8]

373+-- >>> let i = row (0 `As` #real :* 1 `As` #imaginary :* Nil) :: Expression '[] 'Ungrouped '[] ('NotNull Complex)

374+-- >>> renderExpression i

375+-- "ROW(0, 1)"

369row

376row

370− :: (SListI (Nulls fields))

377+ :: SListI (Nulls fields)

371 => NP (Aliased (Expression relation grouping params)) (Nulls fields)

378 => NP (Aliased (Expression relation grouping params)) (Nulls fields)

379+ -- ^ zero or more expressions for the row field values

372 -> Expression relation grouping params (nullity ('PGcomposite fields))

380 -> Expression relation grouping params (nullity ('PGcomposite fields))

373row exprs = UnsafeExpression $ "ROW" <> parenthesized

381row exprs = UnsafeExpression $ "ROW" <> parenthesized

374 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

382 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

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

@@ -37,7 +37,7 @@ let

37 , up = void . define $

38 createTable #users

39 ( serial `As` #id :*

40− (text & hasNotNull) `As` #name :* Nil )

40+ (text & notNullable) `As` #name :* Nil )

41 ( primaryKey #id `As` #pk_users :* Nil )

42 , down = void . define $ dropTable #users

43 }

@@ -52,8 +52,8 @@ let

52 , up = void . define $

53 createTable #emails

54 ( serial `As` #id :*

55− (int & hasNotNull) `As` #user_id :*

55+ (int & notNullable) `As` #user_id :*

56− (text & hasNull) `As` #email :* Nil )

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

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

58 foreignKey #user_id #users #id

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

@@ -285,8 +285,8 @@ createMigrations

285 => Definition schema schema

286createMigrations =

287 createTableIfNotExists #schema_migrations

288− ( (text & hasNotNull) `As` #name :*

288+ ( (text & notNullable) `As` #name :*

289− (timestampWithTimeZone & hasNotNull & default_ currentTimestamp)

289+ (timestampWithTimeZone & notNullable & default_ currentTimestamp)

290 `As` #executed_at :* Nil )

291 ( unique (#name :* Nil) `As` #migrations_unique_name :* Nil )

292

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+10

@@ -426,10 +426,20 @@ selectDistinctDotStar rel relations = UnsafeQuery $

426 "SELECT DISTINCT" <+> renderAlias rel <> ".*"

427 <+> renderTableExpression relations

428

429+-- | `values` computes a row value or set of row values

430+-- specified by value expressions. It is most commonly used

431+-- to generate a “constant table” within a larger command,

432+-- but it can be used on its own.

433+--

434+-- >>> type Row = '["a" ::: 'NotNull 'PGint4, "b" ::: 'NotNull 'PGtext]

435+-- >>> let query = values (1 `As` #a :* "one" `As` #b :* Nil) [] :: Query '[] '[] Row

436+-- >>> renderQuery query

437+-- "SELECT * FROM (VALUES (1, E'one')) AS t (\"a\", \"b\")"

429values

438values

430 :: SListI cols

439 :: SListI cols

431 => NP (Aliased (Expression '[] 'Ungrouped params)) cols

440 => NP (Aliased (Expression '[] 'Ungrouped params)) cols

432 -> [NP (Aliased (Expression '[] 'Ungrouped params)) cols]

441 -> [NP (Aliased (Expression '[] 'Ungrouped params)) cols]

442+ -- ^ When more than one row is specified, all the rows must

433 -> Query schema params cols

443 -> Query schema params cols

434values rw rws = UnsafeQuery $ "SELECT * FROM"

444values rw rws = UnsafeQuery $ "SELECT * FROM"

435 <+> parenthesized (

445 <+> parenthesized (

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+72−4

@@ -328,6 +328,7 @@ type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

328type family TableToColumns (table :: TableType) :: ColumnsType where

329 TableToColumns (constraints :=> columns) = columns

330

331+-- | Convert a table to a relation.

331type family TableToRelation (table :: TableType) :: RelationType where

332type family TableToRelation (table :: TableType) :: RelationType where

332 TableToRelation tab = ColumnsToRelation (TableToColumns tab)

333 TableToRelation tab = ColumnsToRelation (TableToColumns tab)

333

334

@@ -414,6 +415,12 @@ type family AliasesOf aliaseds where

414 AliasesOf '[] = '[]

415 AliasesOf '[] = '[]

415 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

416 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

416

417

418+-- | The `ZipAliased` class provides a type family for zipping

419+-- `Symbol` lists together with arbitrary lists of the same size,

420+-- with an associated type family `ZipAs`, together with

421+-- a method `zipAs` for zipping heterogeneous lists of `Alias`es

422+-- together with a heterogeneous list of expressions into

423+-- a heterogeneous list of `Aliased` expressions.

417class

424class

418 ( SListI (ZipAs ns xs)

425 ( SListI (ZipAs ns xs)

419 , All KnownSymbol ns

426 , All KnownSymbol ns

@@ -443,7 +450,8 @@ instance

443type HasUnique alias fields field = fields ~ '[alias ::: field]

450type HasUnique alias fields field = fields ~ '[alias ::: field]

444

451

445-- | @Has alias fields field@ is a constraint that proves that

452-- | @Has alias fields field@ is a constraint that proves that

446−-- @fields@ has a field of @alias ::: field@.

453+-- @fields@ has a field of @alias ::: field@, inferring @field@

454+-- from @alias@ and @fields@.

447class KnownSymbol alias =>

455class KnownSymbol alias =>

448 Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)

456 Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)

449 | alias fields -> field where

457 | alias fields -> field where

@@ -452,6 +460,8 @@ instance {-# OVERLAPPING #-} KnownSymbol alias

452instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

460instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

453 => Has alias (field' ': fields) field

461 => Has alias (field' ': fields) field

454

462

463+-- | `HasAll` extends `Has` to take lists of @aliases@ and @fields@ and infer

464+-- a list of @subfields@.

455class

465class

456 ( All KnownSymbol aliases

466 ( All KnownSymbol aliases

457 ) => HasAll

467 ) => HasAll

@@ -509,6 +519,7 @@ type family SameTypes (columns0 :: ColumnsType) (columns1 :: ColumnsType)

509 SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

519 SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

510 = (ty0 ~ ty1, SameTypes columns0 columns1)

520 = (ty0 ~ ty1, SameTypes columns0 columns1)

511

521

522+-- | Equality constraint on the underlying `PGType` of two columns.

512class SamePGType

523class SamePGType

513 (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

524 (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

514instance ty0 ~ ty1 => SamePGType

525instance ty0 ~ ty1 => SamePGType

@@ -596,6 +607,7 @@ type family Rename alias0 alias1 xs where

596 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

607 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

597 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

608 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

598

609

610+-- | `MapMaybes` is used in the binary instances of composite types.

599class MapMaybes xs where

611class MapMaybes xs where

600 type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

612 type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

601 maybes :: NP Maybe xs -> NP I (Maybes xs)

613 maybes :: NP Maybe xs -> NP I (Maybes xs)

@@ -609,6 +621,8 @@ instance MapMaybes xs => MapMaybes (x ': xs) where

609 maybes (x :* xs) = I x :* maybes xs

621 maybes (x :* xs) = I x :* maybes xs

610 unMaybes (I mx :* xs) = mx :* unMaybes xs

622 unMaybes (I mx :* xs) = mx :* unMaybes xs

611

623

624+-- | `Nulls` is used to construct a `Squeal.Postgresql.Expression.row`

625+-- of a composite type.

612type family Nulls tys where

626type family Nulls tys where

613 Nulls '[] = '[]

627 Nulls '[] = '[]

614 Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys

628 Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys

@@ -676,7 +690,7 @@ type family LabelsOf (conss :: [Type.ConstructorInfo]) :: [Symbol] where

676 LabelsOf (cons ': conss) = LabelOf cons ': LabelsOf conss

690 LabelsOf (cons ': conss) = LabelOf cons ': LabelsOf conss

677

691

678-- | The `PG` type family embeds a subset of Haskell types

692-- | The `PG` type family embeds a subset of Haskell types

679−-- as basic Postgres types.

693+-- as Postgres basic types.

680--

694--

681-- >>> :kind! PG LocalTime

695-- >>> :kind! PG LocalTime

682-- PG LocalTime :: PGType

696-- PG LocalTime :: PGType

@@ -707,25 +721,67 @@ type family PG (hask :: Type) :: PGType where

707 PG (NetAddr IP) = 'PGinet

721 PG (NetAddr IP) = 'PGinet

708 PG Value = 'PGjson

722 PG Value = 'PGjson

709 PG ty = TypeError

723 PG ty = TypeError

710− ('Text "There is no basic Postgres type for " ':<>: 'ShowType ty)

724+ ('Text "There is no Postgres basic type for " ':<>: 'ShowType ty)

711

725

726+-- | The `EnumWith` type family embeds Haskell enum types, ADTs with

727+-- nullary constructors, as Postgres enum types

728+--

729+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

730+-- >>> instance Generic Schwarma

731+-- >>> instance HasDatatypeInfo Schwarma

732+-- >>> :kind! EnumWith Schwarma

733+-- EnumWith Schwarma :: PGType

734+-- = 'PGenum '["Beef", "Lamb", "Chicken"]

712type family EnumWith (hask :: Type) :: PGType where

735type family EnumWith (hask :: Type) :: PGType where

713 EnumWith hask = 'PGenum (LabelsWith hask)

736 EnumWith hask = 'PGenum (LabelsWith hask)

714

737

738+-- | The `LabelsWith` type family calculates the constructors of a

739+-- Haskell enum type.

740+--

741+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

742+-- >>> instance Generic Schwarma

743+-- >>> instance HasDatatypeInfo Schwarma

744+-- >>> :kind! LabelsWith Schwarma

745+-- LabelsWith Schwarma :: [Type.ConstructorName]

746+-- = '["Beef", "Lamb", "Chicken"]

715type family LabelsWith (hask :: Type) :: [Type.ConstructorName] where

747type family LabelsWith (hask :: Type) :: [Type.ConstructorName] where

716 LabelsWith hask =

748 LabelsWith hask =

717 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

749 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

718

750

751+-- | The `CompositeWith` type family embeds Haskell record types as

752+-- Postgres composite types, as long as the record fields

753+-- are `Maybe`s of Haskell types that can be embedded as basic types

754+-- with the `PG` type family.

755+--

756+-- >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

757+-- >>> instance Generic Row

758+-- >>> instance HasDatatypeInfo Row

759+-- >>> :kind! CompositeWith Row

760+-- CompositeWith Row :: PGType

761+-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]

719type family CompositeWith (hask :: Type) :: PGType where

762type family CompositeWith (hask :: Type) :: PGType where

720 CompositeWith hask =

763 CompositeWith hask =

721 'PGcomposite (ZipAs (FieldNamesWith hask) (FieldTypesWith hask))

764 'PGcomposite (ZipAs (FieldNamesWith hask) (FieldTypesWith hask))

722

765

766+-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

767+-- >>> instance Generic Row

768+-- >>> instance HasDatatypeInfo Row

769+-- >>> :kind! FieldNamesWith Row

770+-- FieldNamesWith Row :: [Type.FieldName]

771+-- = '["a", "b"]

723type family FieldNamesWith (hask :: Type) :: [Type.FieldName] where

772type family FieldNamesWith (hask :: Type) :: [Type.FieldName] where

724 FieldNamesWith hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))

773 FieldNamesWith hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))

725

774

775+-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

776+-- >>> instance Generic Row

777+-- >>> instance HasDatatypeInfo Row

778+-- >>> :kind! FieldTypesWith Row

779+-- FieldTypesWith Row :: [PGType]

780+-- = '['PGint2, 'PGtimestamp]

726type family FieldTypesWith (hask :: Type) :: [PGType] where

781type family FieldTypesWith (hask :: Type) :: [PGType] where

727 FieldTypesWith hask = FieldTypesOf (RecordCodeOf hask (Code hask))

782 FieldTypesWith hask = FieldTypesOf (RecordCodeOf hask (Code hask))

728

783

784+-- | Calculates constructors of a datatype.

729type family ConstructorsOf (datatype :: Type.DatatypeInfo)

785type family ConstructorsOf (datatype :: Type.DatatypeInfo)

730 :: [Type.ConstructorInfo] where

786 :: [Type.ConstructorInfo] where

731 ConstructorsOf ('Type.ADT _module _datatype constructors) =

787 ConstructorsOf ('Type.ADT _module _datatype constructors) =

@@ -733,6 +789,8 @@ type family ConstructorsOf (datatype :: Type.DatatypeInfo)

733 ConstructorsOf ('Type.Newtype _module _datatype constructor) =

789 ConstructorsOf ('Type.Newtype _module _datatype constructor) =

734 '[constructor]

790 '[constructor]

735

791

792+-- | Calculates the name of a nullary constructor, otherwise

793+-- generates a type error.

736type family ConstructorNameOf (constructors :: Type.ConstructorInfo)

794type family ConstructorNameOf (constructors :: Type.ConstructorInfo)

737 :: Type.ConstructorName where

795 :: Type.ConstructorName where

738 ConstructorNameOf ('Type.Constructor name) = name

796 ConstructorNameOf ('Type.Constructor name) = name

@@ -743,36 +801,46 @@ type family ConstructorNameOf (constructors :: Type.ConstructorInfo)

743 ('Text "ConstructorNameOf error: non-nullary constructor "

801 ('Text "ConstructorNameOf error: non-nullary constructor "

744 ':<>: 'Text name)

802 ':<>: 'Text name)

745

803

804+-- | Calculate the names of nullary constructors.

746type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

805type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

747 :: [Type.ConstructorName] where

806 :: [Type.ConstructorName] where

748 ConstructorNamesOf '[] = '[]

807 ConstructorNamesOf '[] = '[]

749 ConstructorNamesOf (constructor ': constructors) =

808 ConstructorNamesOf (constructor ': constructors) =

750 ConstructorNameOf constructor ': ConstructorNamesOf constructors

809 ConstructorNameOf constructor ': ConstructorNamesOf constructors

751

810

811+-- | Calculate the fields of a datatype.

752−type family FieldsOf (constructor :: Type.DatatypeInfo)

812+type family FieldsOf (datatype :: Type.DatatypeInfo)

753 :: [Type.FieldInfo] where

813 :: [Type.FieldInfo] where

754 FieldsOf ('Type.ADT _module _datatype '[ 'Type.Record _name fields]) =

814 FieldsOf ('Type.ADT _module _datatype '[ 'Type.Record _name fields]) =

755 fields

815 fields

756 FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =

816 FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =

757 fields

817 fields

758

818

819+-- | Calculate the name of a field.

759type family FieldNameOf (field :: Type.FieldInfo) :: Type.FieldName where

820type family FieldNameOf (field :: Type.FieldInfo) :: Type.FieldName where

760 FieldNameOf ('Type.FieldInfo name) = name

821 FieldNameOf ('Type.FieldInfo name) = name

761

822

823+-- | Calculate the names of fields.

762type family FieldNamesOf (fields :: [Type.FieldInfo])

824type family FieldNamesOf (fields :: [Type.FieldInfo])

763 :: [Type.FieldName] where

825 :: [Type.FieldName] where

764 FieldNamesOf '[] = '[]

826 FieldNamesOf '[] = '[]

765 FieldNamesOf (field ': fields) = FieldNameOf field ': FieldNamesOf fields

827 FieldNamesOf (field ': fields) = FieldNameOf field ': FieldNamesOf fields

766

828

829+-- | >>> :kind! FieldTypeOf (Maybe Int16)

830+-- FieldTypeOf (Maybe Int16) :: PGType

831+-- = 'PGint2

767type family FieldTypeOf (maybe :: Type) where

832type family FieldTypeOf (maybe :: Type) where

768 FieldTypeOf (Maybe hask) = PG hask

833 FieldTypeOf (Maybe hask) = PG hask

769 FieldTypeOf ty = TypeError

834 FieldTypeOf ty = TypeError

770 ('Text "FieldTypeOf error: non-Maybe type " ':<>: 'ShowType ty)

835 ('Text "FieldTypeOf error: non-Maybe type " ':<>: 'ShowType ty)

771

836

837+-- | Calculate the types of fields.

772type family FieldTypesOf (fields :: [Type]) where

838type family FieldTypesOf (fields :: [Type]) where

773 FieldTypesOf '[] = '[]

839 FieldTypesOf '[] = '[]

774 FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

840 FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

775

841

842+-- | Inspect the code of an algebraic datatype and ensure it's a product,

843+-- otherwise generate a type error

776type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where

844type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where

777 RecordCodeOf _hask '[tys] = tys

845 RecordCodeOf _hask '[tys] = tys

778 RecordCodeOf hask _tys = TypeError

846 RecordCodeOf hask _tys = TypeError