a244b72..dev · squeal · git.iko.soy

git.iko.soy/squeal

10 files changed+138−146

unifiedsplit

README.md+6−6

@@ -121,7 +121,7 @@ type Schemas = Public Schema

121121

122122Notice the use of type operators.

123123

124−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,

124+`:::` is used to pair an alias `Symbol` with a `SchemumType`,

125125a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's `::`

126126operator.

127127

@@ -180,8 +180,8 @@ DROP TABLE "emails";

180180DROP TABLE "users";

181181```

182182

183−We'll need a Haskell type for @User@s. We give the type `Generics.SOP.Generic` and

184−`Generics.SOP.HasDatatypeInfo` instances so that we can encode and decode @User@s.

183+We'll need a Haskell type for `User`s. We give the type `SOP.Generic` and

184+`SOP.HasDatatypeInfo` instances so that we can encode and decode `User`s.

185185

186186```Haskell

187187>>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)

@@ -189,12 +189,12 @@ We'll need a Haskell type for @User@s. We give the type `Generics.SOP.Generic` a

189189>>> instance SOP.HasDatatypeInfo User

190190```

191191

192−Next, we'll write `Manipulation_`s to insert @User@s into our two tables.

192+Next, we'll write `Manipulation_`s to insert `User`s into our two tables.

193193A `Manipulation_` like `insertInto`, `update` or `deleteFrom`

194194has three type parameters, the schemas it refers to, input parameters

195195and an output row. When

196−we insert into the users table, we will need a parameter for the @name@

197−field but not for the @id@ field. Since it's serial, we can use a default

196+we insert into the users table, we will need a parameter for the `name`

197+field but not for the `id` field. Since it's serial, we can use a default

198198value. However, since the emails table refers to the users table, we will

199199need to retrieve the user id that the insert generates and insert it into

200200the emails table. We can do this in a single `Manipulation_` by using a

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

@@ -53,8 +53,8 @@ setup =

5353 >>>

5454 createTable #emails

5555 ( serial `as` #id :*

56− (int & notNullable) `as` #user_id :*

57− (text & nullable) `as` #email )

56+ hask @Int32 `as` #user_id :*

57+ hask @(Maybe Text) `as` #email )

5858 ( primaryKey #id `as` #pk_emails :*

5959 foreignKey #user_id #users #id

6060 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

squeal-postgresql/squeal-postgresql.cabal−1

@@ -28,7 +28,6 @@ library

2828 Squeal.PostgreSQL.Definition.Function

2929 Squeal.PostgreSQL.Definition.Index

3030 Squeal.PostgreSQL.Definition.Table

31− Squeal.PostgreSQL.Definition.Table.Column

3231 Squeal.PostgreSQL.Definition.Table.Constraint

3332 Squeal.PostgreSQL.Definition.Type

3433 Squeal.PostgreSQL.Definition.Schema

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

@@ -199,7 +199,6 @@ import Squeal.PostgreSQL.Definition.Function as X

199199import Squeal.PostgreSQL.Definition.Index as X

200200import Squeal.PostgreSQL.Definition.Schema as X

201201import Squeal.PostgreSQL.Definition.Table as X

202−import Squeal.PostgreSQL.Definition.Table.Column as X

203202import Squeal.PostgreSQL.Definition.Table.Constraint as X

204203import Squeal.PostgreSQL.Definition.Type as X

205204import Squeal.PostgreSQL.Definition.View as X

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+1

@@ -27,6 +27,7 @@ Squeal data definition language.

2727 , TypeInType

2828 , TypeOperators

2929 , UndecidableSuperClasses

30+ , UndecidableInstances

3031#-}

3132

3233module Squeal.PostgreSQL.Definition

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

@@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC

6262

6363import Squeal.PostgreSQL.Alias

6464import Squeal.PostgreSQL.Definition

65−import Squeal.PostgreSQL.Definition.Table.Column

6665import Squeal.PostgreSQL.Definition.Table.Constraint

6766import Squeal.PostgreSQL.Expression

67+import Squeal.PostgreSQL.Expression.Type

6868import Squeal.PostgreSQL.List

6969import Squeal.PostgreSQL.Render

7070import Squeal.PostgreSQL.Schema

squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsdeleted−105

@@ -1,105 +0,0 @@

1−{-|

2−Module: Squeal.PostgreSQL.Definition.Table.Column

3−Description: Column type expressions

4−Copyright: (c) Eitan Chatav, 2017

5−Maintainer: eitan@morphism.tech

6−Stability: experimental

7−

8−Column type expressions.

9−-}

10−

11−{-# LANGUAGE

12− AllowAmbiguousTypes

13− , ConstraintKinds

14− , DeriveAnyClass

15− , DeriveGeneric

16− , DerivingStrategies

17− , FlexibleContexts

18− , FlexibleInstances

19− , GADTs

20− , LambdaCase

21− , MultiParamTypeClasses

22− , OverloadedLabels

23− , OverloadedStrings

24− , RankNTypes

25− , ScopedTypeVariables

26− , TypeApplications

27− , TypeInType

28− , TypeOperators

29− , UndecidableSuperClasses

30−#-}

31−

32−module Squeal.PostgreSQL.Definition.Table.Column

33− ( ColumnTypeExpression (..)

34− , nullable

35− , notNullable

36− , default_

37− , serial2

38− , smallserial

39− , serial4

40− , serial

41− , serial8

42− , bigserial

43− ) where

44−

45−import Control.DeepSeq

46−import Data.ByteString

47−

48−import qualified GHC.Generics as GHC

49−

50−import Squeal.PostgreSQL.Alias

51−import Squeal.PostgreSQL.Expression

52−import Squeal.PostgreSQL.Expression.Type

53−import Squeal.PostgreSQL.Render

54−import Squeal.PostgreSQL.Schema

55−

56−-- $setup

57−-- >>> import Squeal.PostgreSQL

58−

59−-- | `ColumnTypeExpression`s are used in `createTable` commands.

60−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)

61− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

62− deriving (GHC.Generic,Show,Eq,Ord,NFData)

63−instance RenderSQL (ColumnTypeExpression schemas ty) where

64− renderSQL = renderColumnTypeExpression

65−

66−-- | used in `createTable` commands as a column constraint to note that

67−-- @NULL@ may be present in a column

68−nullable

69− :: TypeExpression schemas (nullity ty)

70− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)

71−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"

72−

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

74−-- @NULL@ is not present in a column

75−notNullable

76− :: TypeExpression schemas (nullity ty)

77− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)

78−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"

79−

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

81−default_

82− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty

83− -> ColumnTypeExpression schemas ('NoDef :=> ty)

84− -> ColumnTypeExpression schemas ('Def :=> ty)

85−default_ x ty = UnsafeColumnTypeExpression $

86− renderSQL ty <+> "DEFAULT" <+> renderExpression x

87−

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

89−-- unique identifier columns with type `PGint2`

90−serial2, smallserial

91− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)

92−serial2 = UnsafeColumnTypeExpression "serial2"

93−smallserial = UnsafeColumnTypeExpression "smallserial"

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

95−-- unique identifier columns with type `PGint4`

96−serial4, serial

97− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)

98−serial4 = UnsafeColumnTypeExpression "serial4"

99−serial = UnsafeColumnTypeExpression "serial"

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

101−-- unique identifier columns with type `PGint8`

102−serial8, bigserial

103− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)

104−serial8 = UnsafeColumnTypeExpression "serial8"

105−bigserial = UnsafeColumnTypeExpression "bigserial"

squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+95−4

@@ -23,15 +23,16 @@ Type expressions.

2323 , ScopedTypeVariables

2424 , TypeApplications

2525 , TypeOperators

26+ , UndecidableInstances

2627#-}

2728

2829module Squeal.PostgreSQL.Expression.Type

29− ( TypeExpression (..)

30− , cast

30+ ( -- * type casting

31+ cast

3132 , astype

3233 , inferredtype

33− , PGTyped (..)

34− , FieldTyped (..)

34+ -- * type expressions

35+ , TypeExpression (..)

3536 , typedef

3637 , typetable

3738 , typeview

@@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type

7879 , tsrange

7980 , tstzrange

8081 , daterange

82+ -- * column type definitions

83+ , ColumnTypeExpression (..)

84+ , nullable

85+ , notNullable

86+ , default_

87+ , serial2

88+ , smallserial

89+ , serial4

90+ , serial

91+ , serial8

92+ , bigserial

93+ , hask

94+ -- * type inference

95+ , PGTyped (..)

96+ , PGNullityTyped (..)

97+ , FieldTyped (..)

8198 ) where

8299

83100import Control.DeepSeq

@@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP

91108

92109import Squeal.PostgreSQL.Alias

93110import Squeal.PostgreSQL.Expression

111+import Squeal.PostgreSQL.PG

94112import Squeal.PostgreSQL.Render

95113import Squeal.PostgreSQL.Schema

96114

@@ -132,6 +150,7 @@ astype = cast

132150inferredtype

133151 :: PGTyped schemas ty

134152 => Expression outer common grp schemas params from ty

153+ -- ^ value

135154 -> Expression outer common grp schemas params from ty

136155inferredtype = astype pgtype

137156

@@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where

151170typedef

152171 :: (Has sch schemas schema, Has td schema ('Typedef ty))

153172 => QualifiedAlias sch td

173+ -- ^ type alias

154174 -> TypeExpression schemas (null ty)

155175typedef = UnsafeTypeExpression . renderSQL

156176

@@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL

159179typetable

160180 :: (Has sch schemas schema, Has tab schema ('Table table))

161181 => QualifiedAlias sch tab

182+ -- ^ table alias

162183 -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))

163184typetable = UnsafeTypeExpression . renderSQL

164185

@@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL

167188typeview

168189 :: (Has sch schemas schema, Has vw schema ('View view))

169190 => QualifiedAlias sch vw

191+ -- ^ view alias

170192 -> TypeExpression schemas (null ('PGcomposite view))

171193typeview = UnsafeTypeExpression . renderSQL

172194

@@ -353,3 +375,72 @@ class FieldTyped schemas ty where

353375instance (KnownSymbol alias, PGTyped schemas ty)

354376 => FieldTyped schemas (alias ::: ty) where

355377 fieldtype = pgtype `As` Alias

378+

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

380+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)

381+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

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

383+instance RenderSQL (ColumnTypeExpression schemas ty) where

384+ renderSQL = renderColumnTypeExpression

385+

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

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

388+nullable

389+ :: TypeExpression schemas (nullity ty)

390+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)

391+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"

392+

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

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

395+notNullable

396+ :: TypeExpression schemas (nullity ty)

397+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)

398+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"

399+

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

401+default_

402+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty

403+ -> ColumnTypeExpression schemas ('NoDef :=> ty)

404+ -> ColumnTypeExpression schemas ('Def :=> ty)

405+default_ x ty = UnsafeColumnTypeExpression $

406+ renderSQL ty <+> "DEFAULT" <+> renderExpression x

407+

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

409+-- unique identifier columns with type `PGint2`

410+serial2, smallserial

411+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)

412+serial2 = UnsafeColumnTypeExpression "serial2"

413+smallserial = UnsafeColumnTypeExpression "smallserial"

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

415+-- unique identifier columns with type `PGint4`

416+serial4, serial

417+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)

418+serial4 = UnsafeColumnTypeExpression "serial4"

419+serial = UnsafeColumnTypeExpression "serial"

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

421+-- unique identifier columns with type `PGint8`

422+serial8, bigserial

423+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)

424+serial8 = UnsafeColumnTypeExpression "serial8"

425+bigserial = UnsafeColumnTypeExpression "bigserial"

426+

427+-- | Like @PGTyped@ but also accounts for nullity.

428+class PGNullityTyped schemas (nullty :: NullityType) where

429+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)

430+

431+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where

432+ pgNullityType = nullable (pgtype @_ @('Null ty))

433+

434+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where

435+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))

436+

437+-- | Allow you to specify pg column types in relation to haskell types.

438+-- >>> printSQL $ hask @(Maybe String)

439+-- text NULL

440+--

441+-- >>> printSQL $ hask @Double

442+-- float8 NOT NULL

443+hask

444+ :: forall hask schemas. PGNullityTyped schemas (NullPG hask)

445+ => ColumnTypeExpression schemas ('NoDef :=> NullPG hask)

446+hask = pgNullityType

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

@@ -168,7 +168,6 @@ import Squeal.PostgreSQL.Alias

168168import Squeal.PostgreSQL.Binary

169169import Squeal.PostgreSQL.Definition

170170import Squeal.PostgreSQL.Definition.Table

171−import Squeal.PostgreSQL.Definition.Table.Column

172171import Squeal.PostgreSQL.Definition.Table.Constraint

173172import Squeal.PostgreSQL.Expression.Comparison

174173import Squeal.PostgreSQL.Expression.Parameter

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+33−25

@@ -554,9 +554,9 @@ select_ = select . List

554554-- be subject to the elimination of duplicate rows using `selectDistinct`.

555555selectDistinct

556556 :: (SListI columns, columns ~ (col ': cols))

557− => Selection outer commons 'Ungrouped schemas params from columns

557+ => Selection outer commons grp schemas params from columns

558558 -- ^ selection

559− -> TableExpression outer commons 'Ungrouped schemas params from

559+ -> TableExpression outer commons grp schemas params from

560560 -- ^ intermediate virtual table

561561 -> Query outer commons schemas params columns

562562selectDistinct selection tabexpr = UnsafeQuery $

@@ -568,9 +568,9 @@ selectDistinct selection tabexpr = UnsafeQuery $

568568-- of a general `Selection`.

569569selectDistinct_

570570 :: (SListI columns, columns ~ (col ': cols))

571− => NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns

571+ => NP (Aliased (Expression outer commons grp schemas params from)) columns

572572 -- ^ select list

573− -> TableExpression outer commons 'Ungrouped schemas params from

573+ -> TableExpression outer commons grp schemas params from

574574 -- ^ intermediate virtual table

575575 -> Query outer commons schemas params columns

576576selectDistinct_ = selectDistinct . List

@@ -580,14 +580,21 @@ selectDistinct_ = selectDistinct . List

580580the given expressions evaluate to equal. The DISTINCT ON expressions are

581581interpreted using the same rules as for ORDER BY. ORDER BY is used to

582582ensure that the desired row appears first.

583+

584+The DISTINCT ON expression(s) must match the leftmost ORDER BY expression(s).

585+The ORDER BY clause will normally contain additional expression(s) that

586+determine the desired precedence of rows within each DISTINCT ON group.

587+

588+In order to guarantee they match and reduce redundancy, this function

589+will prepend the The DISTINCT ON expressions to the ORDER BY clause.

583590-}

584591selectDistinctOn

585592 :: (SListI columns, columns ~ (col ': cols))

586− => [SortExpression outer commons 'Ungrouped schemas params from]

587− -- ^ distinct on and return the first row in ordering

588− -> Selection outer commons 'Ungrouped schemas params from columns

593+ => [SortExpression outer commons grp schemas params from]

594+ -- ^ DISTINCT ON expression(s) and prepended to ORDER BY clause

595+ -> Selection outer commons grp schemas params from columns

589596 -- ^ selection

590− -> TableExpression outer commons 'Ungrouped schemas params from

597+ -> TableExpression outer commons grp schemas params from

591598 -- ^ intermediate virtual table

592599 -> Query outer commons schemas params columns

593600selectDistinctOn distincts selection tab = UnsafeQuery $

@@ -608,11 +615,11 @@ selectDistinctOn distincts selection tab = UnsafeQuery $

608615-- of a general `Selection`.

609616selectDistinctOn_

610617 :: (SListI columns, columns ~ (col ': cols))

611− => [SortExpression outer commons 'Ungrouped schemas params from]

618+ => [SortExpression outer commons grp schemas params from]

612619 -- ^ distinct on and return the first row in ordering

613− -> NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns

620+ -> NP (Aliased (Expression outer commons grp schemas params from)) columns

614621 -- ^ selection

615− -> TableExpression outer commons 'Ungrouped schemas params from

622+ -> TableExpression outer commons grp schemas params from

616623 -- ^ intermediate virtual table

617624 -> Query outer commons schemas params columns

618625selectDistinctOn_ distincts = selectDistinctOn distincts . List

@@ -750,7 +757,7 @@ instance RenderSQL (TableExpression outer commons grp schemas params from) where

750757from

751758 :: FromClause outer commons schemas params from -- ^ table reference

752759 -> TableExpression outer commons 'Ungrouped schemas params from

753−from tab = TableExpression tab [] NoGroups NoHaving [] [] []

760+from tab = TableExpression tab [] noGroups NoHaving [] [] []

754761

755762-- | A `where_` is an endomorphism of `TableExpression`s which adds a

756763-- search condition to the `whereClause`.

@@ -771,7 +778,7 @@ groupBy

771778groupBy bys rels = TableExpression

772779 { fromClause = fromClause rels

773780 , whereClause = whereClause rels

774− , groupByClause = Group bys

781+ , groupByClause = group bys

775782 , havingClause = Having []

776783 , orderByClause = []

777784 , limitClause = limitClause rels

@@ -985,19 +992,20 @@ instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])

985992-- done on @NoGroups@ while all output `Expression`s must be aggregated

986993-- in @Group Nil@. In general, all output `Expression`s in the

987994-- complement of @bys@ must be aggregated in @Group bys@.

988−data GroupByClause grp from where

989− NoGroups :: GroupByClause 'Ungrouped from

990− Group

991− :: SListI bys

992− => NP (By from) bys

993− -> GroupByClause ('Grouped bys) from

994−

995−-- | Renders a `GroupByClause`.

995+newtype GroupByClause grp from = UnsafeGroupByClause

996+ { renderGroupByClause :: ByteString }

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

996998instance RenderSQL (GroupByClause grp from) where

997− renderSQL = \case

998− NoGroups -> ""

999− Group Nil -> ""

1000− Group bys -> " GROUP BY" <+> renderCommaSeparated renderSQL bys

999+ renderSQL = renderGroupByClause

1000+noGroups :: GroupByClause 'Ungrouped from

1001+noGroups = UnsafeGroupByClause ""

1002+group

1003+ :: SListI bys

1004+ => NP (By from) bys

1005+ -> GroupByClause ('Grouped bys) from

1006+group bys = UnsafeGroupByClause $ case bys of

1007+ Nil -> ""

1008+ bys' -> " GROUP BY" <+> renderCommaSeparated renderSQL bys'

10011009

10021010-- | A `HavingClause` is used to eliminate groups that are not of interest.

10031011-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`