c42b09d · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

more rehierarching

c42b09dEitan Chatav7 years ago

squeal-postgresql/squeal-postgresql.cabal+2

compare with dev

unifiedsplit

@@ -28,6 +28,8 @@ library

28 Squeal.PostgreSQL.Definition.Function

29 Squeal.PostgreSQL.Definition.Index

30 Squeal.PostgreSQL.Definition.Table

31+ Squeal.PostgreSQL.Definition.Table.Column

32+ Squeal.PostgreSQL.Definition.Table.Constraint

31 Squeal.PostgreSQL.Definition.Type

33 Squeal.PostgreSQL.Definition.Type

32 Squeal.PostgreSQL.Definition.Schema

34 Squeal.PostgreSQL.Definition.Schema

33 Squeal.PostgreSQL.Definition.View

35 Squeal.PostgreSQL.Definition.View

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

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

199import Squeal.PostgreSQL.Definition.Index as X

200import Squeal.PostgreSQL.Definition.Schema as X

201import Squeal.PostgreSQL.Definition.Table as X

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

203+import Squeal.PostgreSQL.Definition.Table.Constraint as X

202import Squeal.PostgreSQL.Definition.Type as X

204import Squeal.PostgreSQL.Definition.Type as X

203import Squeal.PostgreSQL.Definition.View as X

205import Squeal.PostgreSQL.Definition.View as X

204import Squeal.PostgreSQL.Expression as X

206import Squeal.PostgreSQL.Expression as X

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

@@ -54,7 +54,7 @@ import qualified Generics.SOP as SOP

54import qualified GHC.Generics as GHC

56import Squeal.PostgreSQL.Alias

57−import Squeal.PostgreSQL.Definition (Definition (..))

57+import Squeal.PostgreSQL.Definition

58import Squeal.PostgreSQL.Expression

59import Squeal.PostgreSQL.Expression.Type

60import Squeal.PostgreSQL.List

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

@@ -49,7 +49,7 @@ import GHC.TypeLits

49import qualified GHC.Generics as GHC

51import Squeal.PostgreSQL.Alias

52−import Squeal.PostgreSQL.Definition (Definition (..))

52+import Squeal.PostgreSQL.Definition

53import Squeal.PostgreSQL.Expression.Sort

54import Squeal.PostgreSQL.Render

55import Squeal.PostgreSQL.Schema

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

@@ -39,7 +39,7 @@ module Squeal.PostgreSQL.Definition.Schema

39import GHC.TypeLits

41import Squeal.PostgreSQL.Alias

42−import Squeal.PostgreSQL.Definition (Definition (..))

42+import Squeal.PostgreSQL.Definition

43import Squeal.PostgreSQL.Render

44import Squeal.PostgreSQL.Schema

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

@@ -34,14 +34,6 @@ module Squeal.PostgreSQL.Definition.Table

34 , createTableIfNotExists

35 , dropTable

36 , dropTableIfExists

37− , TableConstraintExpression (..)

38− , check

39− , unique

40− , primaryKey

41− , foreignKey

42− , ForeignKeyed

43− , OnDeleteClause (..)

44− , OnUpdateClause (..)

45 , alterTable

37 , alterTable

46 , alterTableRename

38 , alterTableRename

47 , AlterTable (..)

39 , AlterTable (..)

@@ -57,17 +49,6 @@ module Squeal.PostgreSQL.Definition.Table

57 , setNotNull

49 , setNotNull

58 , dropNotNull

50 , dropNotNull

59 , alterType

51 , alterType

60− -- * Columns

61− , ColumnTypeExpression (..)

62− , nullable

63− , notNullable

64− , default_

65− , serial2

66− , smallserial

67− , serial4

68− , serial

69− , serial8

70− , bigserial

71 ) where

52 ) where

73import Control.DeepSeq

54import Control.DeepSeq

@@ -78,10 +59,10 @@ import qualified Generics.SOP as SOP

78import qualified GHC.Generics as GHC

59import qualified GHC.Generics as GHC

80import Squeal.PostgreSQL.Alias

61import Squeal.PostgreSQL.Alias

81−import Squeal.PostgreSQL.Definition (Definition (..))

62+import Squeal.PostgreSQL.Definition

63+import Squeal.PostgreSQL.Definition.Table.Column

64+import Squeal.PostgreSQL.Definition.Table.Constraint

82import Squeal.PostgreSQL.Expression

65import Squeal.PostgreSQL.Expression

83−import Squeal.PostgreSQL.Expression.Logic

84−import Squeal.PostgreSQL.Expression.Type

85import Squeal.PostgreSQL.List

66import Squeal.PostgreSQL.List

86import Squeal.PostgreSQL.Render

67import Squeal.PostgreSQL.Render

87import Squeal.PostgreSQL.Schema

68import Squeal.PostgreSQL.Schema

@@ -195,288 +176,6 @@ renderCreation tab columns constraints = renderSQL tab

195 renderConstraint (constraint `As` alias) =

176 renderConstraint (constraint `As` alias) =

196 "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint

177 "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint

197

178

198−-- | Data types are a way to limit the kind of data that can be stored in a

199−-- table. For many applications, however, the constraint they provide is

200−-- too coarse. For example, a column containing a product price should

201−-- probably only accept positive values. But there is no standard data type

202−-- that accepts only positive numbers. Another issue is that you might want

203−-- to constrain column data with respect to other columns or rows.

204−-- For example, in a table containing product information,

205−-- there should be only one row for each product number.

206−-- `TableConstraint`s give you as much control over the data in your tables

207−-- as you wish. If a user attempts to store data in a column that would

208−-- violate a constraint, an error is raised. This applies

209−-- even if the value came from the default value definition.

210−newtype TableConstraintExpression

211− (sch :: Symbol)

212− (tab :: Symbol)

213− (schemas :: SchemasType)

214− (constraint :: TableConstraint)

215− = UnsafeTableConstraintExpression

216− { renderTableConstraintExpression :: ByteString }

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

218−instance RenderSQL

219− (TableConstraintExpression sch tab schemas constraint) where

220− renderSQL = renderTableConstraintExpression

221−

222−{-| A `check` constraint is the most generic `TableConstraint` type.

223−It allows you to specify that the value in a certain column must satisfy

224−a Boolean (truth-value) expression.

225−

226−>>> :{

227−type Schema = '[

228− "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[

229− "a" ::: 'NoDef :=> 'NotNull 'PGint4,

230− "b" ::: 'NoDef :=> 'NotNull 'PGint4

231− ])]

232−:}

233−

234−>>> :{

235−let

236− definition :: Definition (Public '[]) (Public Schema)

237− definition = createTable #tab

238− ( (int & notNullable) `as` #a :*

239− (int & notNullable) `as` #b )

240− ( check (#a :* #b) (#a .> #b) `as` #inequality )

241−:}

242−

243−>>> printSQL definition

244−CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));

245−-}

246−check

247− :: ( Has sch schemas schema

248− , Has tab schema ('Table table)

249− , HasAll aliases (TableToRow table) subcolumns )

250− => NP Alias aliases

251− -- ^ specify the subcolumns which are getting checked

252− -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])

253− -- ^ a closed `Condition` on those subcolumns

254− -> TableConstraintExpression sch tab schemas ('Check aliases)

255−check _cols condition = UnsafeTableConstraintExpression $

256− "CHECK" <+> parenthesized (renderSQL condition)

257−

258−{-| A `unique` constraint ensure that the data contained in a column,

259−or a group of columns, is unique among all the rows in the table.

260−

261−>>> :{

262−type Schema = '[

263− "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[

264− "a" ::: 'NoDef :=> 'Null 'PGint4,

265− "b" ::: 'NoDef :=> 'Null 'PGint4

266− ])]

267−:}

268−

269−>>> :{

270−let

271− definition :: Definition (Public '[]) (Public Schema)

272− definition = createTable #tab

273− ( (int & nullable) `as` #a :*

274− (int & nullable) `as` #b )

275− ( unique (#a :* #b) `as` #uq_a_b )

276−:}

277−

278−>>> printSQL definition

279−CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));

280−-}

281−unique

282− :: ( Has sch schemas schema

283− , Has tab schema('Table table)

284− , HasAll aliases (TableToRow table) subcolumns )

285− => NP Alias aliases

286− -- ^ specify subcolumns which together are unique for each row

287− -> TableConstraintExpression sch tab schemas ('Unique aliases)

288−unique columns = UnsafeTableConstraintExpression $

289− "UNIQUE" <+> parenthesized (renderSQL columns)

290−

291−{-| A `primaryKey` constraint indicates that a column, or group of columns,

292−can be used as a unique identifier for rows in the table.

293−This requires that the values be both unique and not null.

294−

295−>>> :{

296−type Schema = '[

297− "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[

298− "id" ::: 'Def :=> 'NotNull 'PGint4,

299− "name" ::: 'NoDef :=> 'NotNull 'PGtext

300− ])]

301−:}

302−

303−>>> :{

304−let

305− definition :: Definition (Public '[]) (Public Schema)

306− definition = createTable #tab

307− ( serial `as` #id :*

308− (text & notNullable) `as` #name )

309− ( primaryKey #id `as` #pk_id )

310−:}

311−

312−>>> printSQL definition

313−CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));

314−-}

315−primaryKey

316− :: ( Has sch schemas schema

317− , Has tab schema ('Table table)

318− , HasAll aliases (TableToColumns table) subcolumns

319− , AllNotNull subcolumns )

320− => NP Alias aliases

321− -- ^ specify the subcolumns which together form a primary key.

322− -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)

323−primaryKey columns = UnsafeTableConstraintExpression $

324− "PRIMARY KEY" <+> parenthesized (renderSQL columns)

325−

326−{-| A `foreignKey` specifies that the values in a column

327−(or a group of columns) must match the values appearing in some row of

328−another table. We say this maintains the referential integrity

329−between two related tables.

330−

331−>>> :{

332−type Schema =

333− '[ "users" ::: 'Table (

334− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

335− '[ "id" ::: 'Def :=> 'NotNull 'PGint4

336− , "name" ::: 'NoDef :=> 'NotNull 'PGtext

337− ])

338− , "emails" ::: 'Table (

339− '[ "pk_emails" ::: 'PrimaryKey '["id"]

340− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

341− ] :=>

342− '[ "id" ::: 'Def :=> 'NotNull 'PGint4

343− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

344− , "email" ::: 'NoDef :=> 'Null 'PGtext

345− ])

346− ]

347−:}

348−

349−>>> :{

350−let

351− setup :: Definition (Public '[]) (Public Schema)

352− setup =

353− createTable #users

354− ( serial `as` #id :*

355− (text & notNullable) `as` #name )

356− ( primaryKey #id `as` #pk_users ) >>>

357− createTable #emails

358− ( serial `as` #id :*

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

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

361− ( primaryKey #id `as` #pk_emails :*

362− foreignKey #user_id #users #id

363− OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

364−in printSQL setup

365−:}

366−CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));

367−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);

368−

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

370−

371−>>> :{

372−type Schema =

373− '[ "employees" ::: 'Table (

374− '[ "employees_pk" ::: 'PrimaryKey '["id"]

375− , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]

376− ] :=>

377− '[ "id" ::: 'Def :=> 'NotNull 'PGint4

378− , "name" ::: 'NoDef :=> 'NotNull 'PGtext

379− , "employer_id" ::: 'NoDef :=> 'Null 'PGint4

380− ])

381− ]

382−:}

383−

384−>>> :{

385−let

386− setup :: Definition (Public '[]) (Public Schema)

387− setup =

388− createTable #employees

389− ( serial `as` #id :*

390− (text & notNullable) `as` #name :*

391− (integer & nullable) `as` #employer_id )

392− ( primaryKey #id `as` #employees_pk :*

393− foreignKey #employer_id #employees #id

394− OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )

395−in printSQL setup

396−:}

397−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);

398−-}

399−foreignKey

400− :: (ForeignKeyed schemas sch schema child parent

401− table reftable

402− columns refcolumns

403− constraints cols

404− reftys tys )

405− => NP Alias columns

406− -- ^ column or columns in the table

407− -> Alias parent

408− -- ^ reference table

409− -> NP Alias refcolumns

410− -- ^ reference column or columns in the reference table

411− -> OnDeleteClause

412− -- ^ what to do when reference is deleted

413− -> OnUpdateClause

414− -- ^ what to do when reference is updated

415− -> TableConstraintExpression sch child schemas

416− ('ForeignKey columns parent refcolumns)

417−foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

418− "FOREIGN KEY" <+> parenthesized (renderSQL keys)

419− <+> "REFERENCES" <+> renderSQL parent

420− <+> parenthesized (renderSQL refs)

421− <+> renderSQL ondel

422− <+> renderSQL onupd

423−

424−-- | A constraint synonym between types involved in a foreign key constraint.

425−type ForeignKeyed schemas

426− sch

427− schema

428− child parent

429− table reftable

430− columns refcolumns

431− constraints cols

432− reftys tys =

433− ( Has sch schemas schema

434− , Has child schema ('Table table)

435− , Has parent schema ('Table reftable)

436− , HasAll columns (TableToColumns table) tys

437− , reftable ~ (constraints :=> cols)

438− , HasAll refcolumns cols reftys

439− , SOP.AllZip SamePGType tys reftys

440− , Uniquely refcolumns constraints )

441−

442−-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.

443−data OnDeleteClause

444− = OnDeleteNoAction

445− -- ^ if any referencing rows still exist when the constraint is checked,

446− -- an error is raised

447− | OnDeleteRestrict -- ^ prevents deletion of a referenced row

448− | OnDeleteCascade

449− -- ^ specifies that when a referenced row is deleted,

450− -- row(s) referencing it should be automatically deleted as well

451− deriving (GHC.Generic,Show,Eq,Ord)

452−instance NFData OnDeleteClause

453−-- | Render `OnDeleteClause`.

454−instance RenderSQL OnDeleteClause where

455− renderSQL = \case

456− OnDeleteNoAction -> "ON DELETE NO ACTION"

457− OnDeleteRestrict -> "ON DELETE RESTRICT"

458− OnDeleteCascade -> "ON DELETE CASCADE"

459−

460−-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked

461−-- when a referenced column is changed (updated).

462−data OnUpdateClause

463− = OnUpdateNoAction

464− -- ^ if any referencing rows has not changed when the constraint is checked,

465− -- an error is raised

466− | OnUpdateRestrict -- ^ prevents update of a referenced row

467− | OnUpdateCascade

468− -- ^ the updated values of the referenced column(s) should be copied

469− -- into the referencing row(s)

470− deriving (GHC.Generic,Show,Eq,Ord)

471−instance NFData OnUpdateClause

472−

473−-- | Render `OnUpdateClause`.

474−instance RenderSQL OnUpdateClause where

475− renderSQL = \case

476− OnUpdateNoAction -> "ON UPDATE NO ACTION"

477− OnUpdateRestrict -> "ON UPDATE RESTRICT"

478− OnUpdateCascade -> "ON UPDATE CASCADE"

479−

480-- | `dropTable` removes a table from the schema.

179-- | `dropTable` removes a table from the schema.

481--

180--

482-- >>> :{

181-- >>> :{

@@ -776,51 +475,3 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

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

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

777alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty

476alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty

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

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

779−

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

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

782− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

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

784−instance RenderSQL (ColumnTypeExpression schemas ty) where

785− renderSQL = renderColumnTypeExpression

786−

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

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

789−nullable

790− :: TypeExpression schemas (nullity ty)

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

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

793−

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

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

796−notNullable

797− :: TypeExpression schemas (nullity ty)

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

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

800−

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

802−default_

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

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

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

806−default_ x ty = UnsafeColumnTypeExpression $

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

808−

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

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

811−serial2, smallserial

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

813−serial2 = UnsafeColumnTypeExpression "serial2"

814−smallserial = UnsafeColumnTypeExpression "smallserial"

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

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

817−serial4, serial

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

819−serial4 = UnsafeColumnTypeExpression "serial4"

820−serial = UnsafeColumnTypeExpression "serial"

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

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

823−serial8, bigserial

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

825−serial8 = UnsafeColumnTypeExpression "serial8"

826−bigserial = UnsafeColumnTypeExpression "bigserial"

squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsnew file+105

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

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

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/Definition/Table/Constraint.hsnew file+339

@@ -0,0 +1,339 @@

1+{-|

2+Module: Squeal.PostgreSQL.Definition.Table.Constraint

3+Description: Table constraint expressions

4+Copyright: (c) Eitan Chatav, 2017

5+Maintainer: eitan@morphism.tech

6+Stability: experimental

8+Table constraint 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.Constraint

33+ ( TableConstraintExpression (..)

34+ , check

35+ , unique

36+ , primaryKey

37+ , foreignKey

38+ , ForeignKeyed

39+ , OnDeleteClause (..)

40+ , OnUpdateClause (..)

41+ ) where

42+

43+import Control.DeepSeq

44+import Data.ByteString

45+import GHC.TypeLits

46+

47+import qualified Generics.SOP as SOP

48+import qualified GHC.Generics as GHC

49+

50+import Squeal.PostgreSQL.Alias

51+import Squeal.PostgreSQL.Expression.Logic

52+import Squeal.PostgreSQL.List

53+import Squeal.PostgreSQL.Render

54+import Squeal.PostgreSQL.Schema

55+

56+-- $setup

57+-- >>> import Squeal.PostgreSQL

58+

59+-- | Data types are a way to limit the kind of data that can be stored in a

60+-- table. For many applications, however, the constraint they provide is

61+-- too coarse. For example, a column containing a product price should

62+-- probably only accept positive values. But there is no standard data type

63+-- that accepts only positive numbers. Another issue is that you might want

64+-- to constrain column data with respect to other columns or rows.

65+-- For example, in a table containing product information,

66+-- there should be only one row for each product number.

67+-- `TableConstraint`s give you as much control over the data in your tables

68+-- as you wish. If a user attempts to store data in a column that would

69+-- violate a constraint, an error is raised. This applies

70+-- even if the value came from the default value definition.

71+newtype TableConstraintExpression

72+ (sch :: Symbol)

73+ (tab :: Symbol)

74+ (schemas :: SchemasType)

75+ (constraint :: TableConstraint)

76+ = UnsafeTableConstraintExpression

77+ { renderTableConstraintExpression :: ByteString }

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

79+instance RenderSQL

80+ (TableConstraintExpression sch tab schemas constraint) where

81+ renderSQL = renderTableConstraintExpression

82+

83+{-| A `check` constraint is the most generic `TableConstraint` type.

84+It allows you to specify that the value in a certain column must satisfy

85+a Boolean (truth-value) expression.

86+

87+>>> :{

88+type Schema = '[

89+ "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[

90+ "a" ::: 'NoDef :=> 'NotNull 'PGint4,

91+ "b" ::: 'NoDef :=> 'NotNull 'PGint4

92+ ])]

93+:}

94+

95+>>> :{

96+let

97+ definition :: Definition (Public '[]) (Public Schema)

98+ definition = createTable #tab

99+ ( (int & notNullable) `as` #a :*

100+ (int & notNullable) `as` #b )

101+ ( check (#a :* #b) (#a .> #b) `as` #inequality )

102+:}

103+

104+>>> printSQL definition

105+CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));

106+-}

107+check

108+ :: ( Has sch schemas schema

109+ , Has tab schema ('Table table)

110+ , HasAll aliases (TableToRow table) subcolumns )

111+ => NP Alias aliases

112+ -- ^ specify the subcolumns which are getting checked

113+ -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])

114+ -- ^ a closed `Condition` on those subcolumns

115+ -> TableConstraintExpression sch tab schemas ('Check aliases)

116+check _cols condition = UnsafeTableConstraintExpression $

117+ "CHECK" <+> parenthesized (renderSQL condition)

118+

119+{-| A `unique` constraint ensure that the data contained in a column,

120+or a group of columns, is unique among all the rows in the table.

121+

122+>>> :{

123+type Schema = '[

124+ "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[

125+ "a" ::: 'NoDef :=> 'Null 'PGint4,

126+ "b" ::: 'NoDef :=> 'Null 'PGint4

127+ ])]

128+:}

129+

130+>>> :{

131+let

132+ definition :: Definition (Public '[]) (Public Schema)

133+ definition = createTable #tab

134+ ( (int & nullable) `as` #a :*

135+ (int & nullable) `as` #b )

136+ ( unique (#a :* #b) `as` #uq_a_b )

137+:}

138+

139+>>> printSQL definition

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

141+-}

142+unique

143+ :: ( Has sch schemas schema

144+ , Has tab schema('Table table)

145+ , HasAll aliases (TableToRow table) subcolumns )

146+ => NP Alias aliases

147+ -- ^ specify subcolumns which together are unique for each row

148+ -> TableConstraintExpression sch tab schemas ('Unique aliases)

149+unique columns = UnsafeTableConstraintExpression $

150+ "UNIQUE" <+> parenthesized (renderSQL columns)

151+

152+{-| A `primaryKey` constraint indicates that a column, or group of columns,

153+can be used as a unique identifier for rows in the table.

154+This requires that the values be both unique and not null.

155+

156+>>> :{

157+type Schema = '[

158+ "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[

159+ "id" ::: 'Def :=> 'NotNull 'PGint4,

160+ "name" ::: 'NoDef :=> 'NotNull 'PGtext

161+ ])]

162+:}

163+

164+>>> :{

165+let

166+ definition :: Definition (Public '[]) (Public Schema)

167+ definition = createTable #tab

168+ ( serial `as` #id :*

169+ (text & notNullable) `as` #name )

170+ ( primaryKey #id `as` #pk_id )

171+:}

172+

173+>>> printSQL definition

174+CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));

175+-}

176+primaryKey

177+ :: ( Has sch schemas schema

178+ , Has tab schema ('Table table)

179+ , HasAll aliases (TableToColumns table) subcolumns

180+ , AllNotNull subcolumns )

181+ => NP Alias aliases

182+ -- ^ specify the subcolumns which together form a primary key.

183+ -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)

184+primaryKey columns = UnsafeTableConstraintExpression $

185+ "PRIMARY KEY" <+> parenthesized (renderSQL columns)

186+

187+{-| A `foreignKey` specifies that the values in a column

188+(or a group of columns) must match the values appearing in some row of

189+another table. We say this maintains the referential integrity

190+between two related tables.

191+

192+>>> :{

193+type Schema =

194+ '[ "users" ::: 'Table (

195+ '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

196+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

197+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext

198+ ])

199+ , "emails" ::: 'Table (

200+ '[ "pk_emails" ::: 'PrimaryKey '["id"]

201+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

202+ ] :=>

203+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

204+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

205+ , "email" ::: 'NoDef :=> 'Null 'PGtext

206+ ])

207+ ]

208+:}

209+

210+>>> :{

211+let

212+ setup :: Definition (Public '[]) (Public Schema)

213+ setup =

214+ createTable #users

215+ ( serial `as` #id :*

216+ (text & notNullable) `as` #name )

217+ ( primaryKey #id `as` #pk_users ) >>>

218+ createTable #emails

219+ ( serial `as` #id :*

220+ (int & notNullable) `as` #user_id :*

221+ (text & nullable) `as` #email )

222+ ( primaryKey #id `as` #pk_emails :*

223+ foreignKey #user_id #users #id

224+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

225+in printSQL setup

226+:}

227+CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));

228+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);

229+

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

231+

232+>>> :{

233+type Schema =

234+ '[ "employees" ::: 'Table (

235+ '[ "employees_pk" ::: 'PrimaryKey '["id"]

236+ , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]

237+ ] :=>

238+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

239+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext

240+ , "employer_id" ::: 'NoDef :=> 'Null 'PGint4

241+ ])

242+ ]

243+:}

244+

245+>>> :{

246+let

247+ setup :: Definition (Public '[]) (Public Schema)

248+ setup =

249+ createTable #employees

250+ ( serial `as` #id :*

251+ (text & notNullable) `as` #name :*

252+ (integer & nullable) `as` #employer_id )

253+ ( primaryKey #id `as` #employees_pk :*

254+ foreignKey #employer_id #employees #id

255+ OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )

256+in printSQL setup

257+:}

258+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);

259+-}

260+foreignKey

261+ :: (ForeignKeyed schemas sch schema child parent

262+ table reftable

263+ columns refcolumns

264+ constraints cols

265+ reftys tys )

266+ => NP Alias columns

267+ -- ^ column or columns in the table

268+ -> Alias parent

269+ -- ^ reference table

270+ -> NP Alias refcolumns

271+ -- ^ reference column or columns in the reference table

272+ -> OnDeleteClause

273+ -- ^ what to do when reference is deleted

274+ -> OnUpdateClause

275+ -- ^ what to do when reference is updated

276+ -> TableConstraintExpression sch child schemas

277+ ('ForeignKey columns parent refcolumns)

278+foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

279+ "FOREIGN KEY" <+> parenthesized (renderSQL keys)

280+ <+> "REFERENCES" <+> renderSQL parent

281+ <+> parenthesized (renderSQL refs)

282+ <+> renderSQL ondel

283+ <+> renderSQL onupd

284+

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

286+type ForeignKeyed schemas

287+ sch

288+ schema

289+ child parent

290+ table reftable

291+ columns refcolumns

292+ constraints cols

293+ reftys tys =

294+ ( Has sch schemas schema

295+ , Has child schema ('Table table)

296+ , Has parent schema ('Table reftable)

297+ , HasAll columns (TableToColumns table) tys

298+ , reftable ~ (constraints :=> cols)

299+ , HasAll refcolumns cols reftys

300+ , SOP.AllZip SamePGType tys reftys

301+ , Uniquely refcolumns constraints )

302+

303+-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.

304+data OnDeleteClause

305+ = OnDeleteNoAction

306+ -- ^ if any referencing rows still exist when the constraint is checked,

307+ -- an error is raised

308+ | OnDeleteRestrict -- ^ prevents deletion of a referenced row

309+ | OnDeleteCascade

310+ -- ^ specifies that when a referenced row is deleted,

311+ -- row(s) referencing it should be automatically deleted as well

312+ deriving (GHC.Generic,Show,Eq,Ord)

313+instance NFData OnDeleteClause

314+-- | Render `OnDeleteClause`.

315+instance RenderSQL OnDeleteClause where

316+ renderSQL = \case

317+ OnDeleteNoAction -> "ON DELETE NO ACTION"

318+ OnDeleteRestrict -> "ON DELETE RESTRICT"

319+ OnDeleteCascade -> "ON DELETE CASCADE"

320+

321+-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked

322+-- when a referenced column is changed (updated).

323+data OnUpdateClause

324+ = OnUpdateNoAction

325+ -- ^ if any referencing rows has not changed when the constraint is checked,

326+ -- an error is raised

327+ | OnUpdateRestrict -- ^ prevents update of a referenced row

328+ | OnUpdateCascade

329+ -- ^ the updated values of the referenced column(s) should be copied

330+ -- into the referencing row(s)

331+ deriving (GHC.Generic,Show,Eq,Ord)

332+instance NFData OnUpdateClause

333+

334+-- | Render `OnUpdateClause`.

335+instance RenderSQL OnUpdateClause where

336+ renderSQL = \case

337+ OnUpdateNoAction -> "ON UPDATE NO ACTION"

338+ OnUpdateRestrict -> "ON UPDATE RESTRICT"

339+ OnUpdateCascade -> "ON UPDATE CASCADE"

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

@@ -50,7 +50,7 @@ import qualified Generics.SOP as SOP

50import Squeal.PostgreSQL.Alias

51import Squeal.PostgreSQL.Expression.Logic

52import Squeal.PostgreSQL.Expression.Type

53−import Squeal.PostgreSQL.Definition (Definition (..))

53+import Squeal.PostgreSQL.Definition

54import Squeal.PostgreSQL.List

55import Squeal.PostgreSQL.PG

56import Squeal.PostgreSQL.Render

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

@@ -39,7 +39,7 @@ module Squeal.PostgreSQL.Definition.View

39import GHC.TypeLits

41import Squeal.PostgreSQL.Alias

42−import Squeal.PostgreSQL.Definition (Definition (..))

42+import Squeal.PostgreSQL.Definition

43import Squeal.PostgreSQL.Query

44import Squeal.PostgreSQL.Render

45import Squeal.PostgreSQL.Schema

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

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

168import Squeal.PostgreSQL.Binary

169import Squeal.PostgreSQL.Definition

170import Squeal.PostgreSQL.Definition.Table

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

172+import Squeal.PostgreSQL.Definition.Table.Constraint

171import Squeal.PostgreSQL.Expression.Comparison

173import Squeal.PostgreSQL.Expression.Comparison

172import Squeal.PostgreSQL.Expression.Parameter

174import Squeal.PostgreSQL.Expression.Parameter

173import Squeal.PostgreSQL.Expression.Time

175import Squeal.PostgreSQL.Expression.Time