2c7844e · squeal · git.iko.soy

git.iko.soy/squeal

documentation and tests

commit2c7844e185926f080e6000eb48c2b15e4c4d0de8 authorEitan Chatav <eitan.chatav@gmail.com> dateSun 3 Jun 2018, 11:02 (8 years ago) parentd541e42

8 files changed+199−66

compare with dev

unifiedsplit

README.md+3−3 squeal-postgresql/exe/Example.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+92−45 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+10−2 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+5−5 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+10 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+72−4

README.md+3−3

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

127127 setup =

128128 createTable #users

129129 ( serial `As` #id :*

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

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

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

132132 createTable #emails

133133 ( serial `As` #id :*

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

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

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

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

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

4545setup =

4646 createTable #users

4747 ( serial `As` #id :*

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

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

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

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

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

5151 >>>

5252 createTable #emails

5353 ( serial `As` #id :*

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

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

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

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

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

6666-- setup =

6767-- createTable #users

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

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

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

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

7171-- createTable #emails

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

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

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

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

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

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

7676-- foreignKey #user_id #users #id

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

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

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

6666 , createView

6767 , dropView

6868 -- * Types

69− , createTypeComposite

7069 , createTypeEnum

71− , HasPGcomposite (..)

72− , HasPGenum (..)

70+ , createTypeEnumWith

71+ , createTypeComposite

72+ , createTypeCompositeWith

7373 , dropType

74+ -- * Columns

7475 , ColumnTypeExpression (..)

75− , hasNull

76− , hasNotNull

76+ , nullable

77+ , notNullable

7778 , default_

7879 , serial2

7980 , smallserial

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

125126-- >>> :set -XOverloadedLabels

126127-- >>> :{

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

129130-- :}

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

131132createTable

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

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

153154-- >>> :{

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

156157-- :}

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

158159createTableIfNotExists

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

234235-- let

235236-- definition :: Definition '[] Schema

236237-- definition = createTable #tab

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

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

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

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

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

240241-- :}

241242--

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

265266-- let

266267-- definition :: Definition '[] Schema

267268-- definition = createTable #tab

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

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

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

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

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

271272-- :}

272273--

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

297298-- definition :: Definition '[] Schema

298299-- definition = createTable #tab

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

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

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

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

302303-- :}

303304--

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

341342-- setup =

342343-- createTable #users

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

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

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

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

346347-- createTable #emails

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

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

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

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

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

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

351352-- foreignKey #user_id #users #id

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

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

375376-- setup =

376377-- createTable #employees

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

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

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

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

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

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

381382-- foreignKey #employer_id #employees #id

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

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

409410 <+> renderOnDeleteClause ondel

410411 <+> renderOnUpdateClause onupd

411412

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

412414type ForeignKeyed schema

413415 child parent

414416 table reftable

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

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

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

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

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

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

582584 -- in renderDefinition definition

583585 -- :}

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

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

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

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

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

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

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

594596 -- in renderDefinition definition

595597 -- :}

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

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

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

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

751753-- definition =

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

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

753755-- in renderDefinition definition

754756-- :}

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

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

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

758760

759−-- | create a view...

761+-- | Create a view.

762+--

760763-- >>> :{

761764-- let

762765-- definition :: Definition

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

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

779782 <+> renderQuery query <> ";"

780783

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

781796dropView

782797 :: Has view schema ('View v)

783798 => Alias view -- ^ view to remove

784799 -> Definition schema (Drop view schema)

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

786801

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

787806createTypeEnum

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

789808 => Alias enum

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

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

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

795814

796−class

797− ( SOP.IsEnumType hask

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.

824+ ( SOP.Generic hask

798825 , SOP.All KnownSymbol (LabelsWith hask)

799− ) => HasPGenum hask where

800− createTypeEnumWith

801− :: KnownSymbol enum

802− => Alias enum

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

804− createTypeEnumWith enum = createTypeEnum enum

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

826+ , KnownSymbol enum

827+ )

828+ => Alias enum

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

830+createTypeEnumWith enum = createTypeEnum enum

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

806832

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

807838createTypeComposite

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

809840 => Alias ty

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

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

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

815846

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.

817856 ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

818857 , SOP.All PGTyped (FieldTypesWith hask)

819− ) => HasPGcomposite hask where

820− createTypeCompositeWith

821− :: KnownSymbol ty

822− => Alias ty

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

824− createTypeCompositeWith ty = createTypeComposite ty $ zipAs

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

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

827− :: NP TypeExpression (FieldTypesWith hask))

858+ , KnownSymbol ty

859+ )

860+ => Alias ty

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

862+createTypeCompositeWith ty = createTypeComposite ty $ zipAs

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

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

865+ :: NP TypeExpression (FieldTypesWith hask))

828866

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

829874dropType

830875 :: Has tydef schema ('Typedef ty)

831876 => Alias tydef

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

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

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

843888

844−hasNull

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

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

891+nullable

845892 :: TypeExpression ty

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

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

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

848895

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

850−-- @NULL@ is not present

851−hasNotNull

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

898+notNullable

852899 :: TypeExpression ty

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

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

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

855902

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

857904default_

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

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

4040 , isNotNull

4141 , matchNull

4242 , nullIf

43− -- ** Arrays, Enums, Composites

43+ -- ** Collections

4444 , array

4545 , row

4646 -- ** Functions

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

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

367367 label = UnsafeExpression $ renderLabel (PGlabel @label)

368368

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

369376row

370− :: (SListI (Nulls fields))

377+ :: SListI (Nulls fields)

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

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

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

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

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

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

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

3737 , up = void . define $

3838 createTable #users

3939 ( serial `As` #id :*

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

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

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

4242 , down = void . define $ dropTable #users

4343 }

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

5252 , up = void . define $

5353 createTable #emails

5454 ( serial `As` #id :*

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

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

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

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

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

5858 foreignKey #user_id #users #id

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

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

285285 => Definition schema schema

286286createMigrations =

287287 createTableIfNotExists #schema_migrations

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

289− (timestampWithTimeZone & hasNotNull & default_ currentTimestamp)

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

289+ (timestampWithTimeZone & notNullable & default_ currentTimestamp)

290290 `As` #executed_at :* Nil )

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

292292

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

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

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

427427 <+> renderTableExpression relations

428428

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

429438values

430439 :: SListI cols

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

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

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

433443 -> Query schema params cols

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

435445 <+> parenthesized (

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

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

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

329329 TableToColumns (constraints :=> columns) = columns

330330

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

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

332333 TableToRelation tab = ColumnsToRelation (TableToColumns tab)

333334

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

414415 AliasesOf '[] = '[]

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

416417

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.

417424class

418425 ( SListI (ZipAs ns xs)

419426 , All KnownSymbol ns

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

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

444451

445452-- | @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@.

447455class KnownSymbol alias =>

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

449457 | alias fields -> field where

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

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

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

454462

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

464+-- a list of @subfields@.

455465class

456466 ( All KnownSymbol aliases

457467 ) => HasAll

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

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

510520 = (ty0 ~ ty1, SameTypes columns0 columns1)

511521

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

512523class SamePGType

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

514525instance ty0 ~ ty1 => SamePGType

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

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

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

598609

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

599611class MapMaybes xs where

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

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

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

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

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

611623

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

625+-- of a composite type.

612626type family Nulls tys where

613627 Nulls '[] = '[]

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

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

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

677691

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

679−-- as basic Postgres types.

693+-- as Postgres basic types.

680694--

681695-- >>> :kind! PG LocalTime

682696-- PG LocalTime :: PGType

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

707721 PG (NetAddr IP) = 'PGinet

708722 PG Value = 'PGjson

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

711725

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"]

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

713736 EnumWith hask = 'PGenum (LabelsWith hask)

714737

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"]

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

716748 LabelsWith hask =

717749 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

718750

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

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

720763 CompositeWith hask =

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

722765

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"]

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

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

725774

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]

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

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

728783

784+-- | Calculates constructors of a datatype.

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

730786 :: [Type.ConstructorInfo] where

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

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

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

734790 '[constructor]

735791

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

793+-- generates a type error.

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

737795 :: Type.ConstructorName where

738796 ConstructorNameOf ('Type.Constructor name) = name

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

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

744802 ':<>: 'Text name)

745803

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

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

747806 :: [Type.ConstructorName] where

748807 ConstructorNamesOf '[] = '[]

749808 ConstructorNamesOf (constructor ': constructors) =

750809 ConstructorNameOf constructor ': ConstructorNamesOf constructors

751810

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

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

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

753813 :: [Type.FieldInfo] where

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

755815 fields

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

757817 fields

758818

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

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

760821 FieldNameOf ('Type.FieldInfo name) = name

761822

823+-- | Calculate the names of fields.

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

763825 :: [Type.FieldName] where

764826 FieldNamesOf '[] = '[]

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

766828

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

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

831+-- = 'PGint2

767832type family FieldTypeOf (maybe :: Type) where

768833 FieldTypeOf (Maybe hask) = PG hask

769834 FieldTypeOf ty = TypeError

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

771836

837+-- | Calculate the types of fields.

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

773839 FieldTypesOf '[] = '[]

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

775841

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

843+-- otherwise generate a type error

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

777845 RecordCodeOf _hask '[tys] = tys

778846 RecordCodeOf hask _tys = TypeError