@@ -14,8 +14,9 @@
1414#-}
1515
1616module Squeal.PostgreSQL.Definition
17− ( -- * Data Definition Language
17+ ( -- * Definition
1818 Definition (UnsafeDefinition, renderDefinition)
19+ -- * Create
1920 , createTable
2021 , TableConstraint (UnsafeTableConstraint, renderTableConstraint)
2122 , check
@@ -26,7 +27,9 @@ module Squeal.PostgreSQL.Definition
2627 , renderOnDelete
2728 , OnUpdate (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)
2829 , renderOnUpdate
30+ -- * Drop
2931 , dropTable
32+ -- * Alter
3033 , alterTable
3134 , alterTableRename
3235 , AlterTable (UnsafeAlterTable, renderAlterTable)
@@ -61,6 +64,10 @@ import Squeal.PostgreSQL.Schema
6164statements
6265-----------------------------------------}
6366
67+-- | A `Definition` is a statement that changes the schema of the
68+-- database, like a `createTable`, `dropTable`, or `alterTable` command.
69+-- `Definition`s may be composed using the `>>>` operator from the
70+-- `Category` typeclass.
6471newtype Definition
6572 (schema0 :: TablesType)
6673 (schema1 :: TablesType)
@@ -76,11 +83,21 @@ instance Category Definition where
7683CREATE statements
7784-----------------------------------------}
7885
86+-- | `createTable` adds a table to the schema.
87+--
88+-- >>> :set -XOverloadedLabels -XDataKinds
89+-- >>> :{
90+-- renderDefinition $
91+-- createTable #tab (int `As` #a :* real `As` #b :* Nil) []
92+-- :}
93+-- "CREATE TABLE tab (a int, b real);"
7994createTable
8095 :: (KnownSymbol table, SListI columns)
81− => Alias table
96+ => Alias table -- ^ the name of the table to add
8297 -> NP (Aliased TypeExpression) (column ': columns)
98+ -- ^ the names and datatype of each column
8399 -> [TableConstraint schema (column ': columns)]
100+ -- ^ constraints that must hold for the table
84101 -> Definition schema (Create table (column ': columns) schema)
85102createTable table columns constraints = UnsafeDefinition $
86103 "CREATE TABLE" <+> renderAlias table
@@ -97,18 +114,55 @@ createTable table columns constraints = UnsafeDefinition $
97114 [] -> ""
98115 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
99116
117+-- | Data types are a way to limit the kind of data that can be stored in a
118+-- table. For many applications, however, the constraint they provide is
119+-- too coarse. For example, a column containing a product price should
120+-- probably only accept positive values. But there is no standard data type
121+-- that accepts only positive numbers. Another issue is that you might want
122+-- to constrain column data with respect to other columns or rows.
123+-- For example, in a table containing product information,
124+-- there should be only one row for each product number.
125+-- `TableConstraint`s give you as much control over the data in your tables
126+-- as you wish. If a user attempts to store data in a column that would
127+-- violate a constraint, an error is raised. This applies
128+-- even if the value came from the default value definition.
100129newtype TableConstraint
101130 (schema :: TablesType)
102131 (columns :: ColumnsType)
103132 = UnsafeTableConstraint { renderTableConstraint :: ByteString }
104133 deriving (GHC.Generic,Show,Eq,Ord,NFData)
105134
135+-- | A `check` constraint is the most generic `TableConstraint` type.
136+-- It allows you to specify that the value in a certain column must satisfy
137+-- a Boolean (truth-value) expression.
138+--
139+-- >>> :set -XOverloadedLabels -XDataKinds
140+-- >>> :{
141+-- renderDefinition $
142+-- createTable #tab
143+-- ( (int & notNull) `As` #a :*
144+-- (int & notNull) `As` #b :* Nil )
145+-- [ check (#a .> #b) ]
146+-- :}
147+-- "CREATE TABLE tab (a int NOT NULL, b int NOT NULL, CHECK ((a > b)));"
106148check
107149 :: Condition '[table ::: columns] 'Ungrouped '[]
108150 -> TableConstraint schema columns
109151check condition = UnsafeTableConstraint $
110152 "CHECK" <+> parenthesized (renderExpression condition)
111153
154+-- | `unique` constraints ensure that the data contained in a column,
155+-- or a group of columns, is unique among all the rows in the table.
156+--
157+-- >>> :set -XOverloadedLabels -XDataKinds
158+-- >>> :{
159+-- renderDefinition $
160+-- createTable #tab
161+-- ( int `As` #a :*
162+-- int `As` #b :* Nil )
163+-- [ unique (Column #a :* Column #b :* Nil) ]
164+-- :}
165+-- "CREATE TABLE tab (a int, b int, UNIQUE (a, b));"
112166unique
113167 :: SListI subcolumns
114168 => NP (Column columns) subcolumns
@@ -116,6 +170,19 @@ unique
116170unique columns = UnsafeTableConstraint $
117171 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
118172
173+-- | A `primaryKey` constraint indicates that a column, or group of columns,
174+-- can be used as a unique identifier for rows in the table.
175+-- This requires that the values be both unique and not null.
176+--
177+-- >>> :set -XOverloadedLabels -XDataKinds
178+-- >>> :{
179+-- renderDefinition $
180+-- createTable #tab
181+-- ( serial `As` #id :*
182+-- (text & notNull) `As` #name :* Nil )
183+-- [ primaryKey (Column #id :* Nil) ]
184+-- :}
185+-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"
119186primaryKey
120187 :: (SListI subcolumns, AllNotNull subcolumns)
121188 => NP (Column columns) subcolumns
@@ -123,6 +190,40 @@ primaryKey
123190primaryKey columns = UnsafeTableConstraint $
124191 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
125192
193+-- | A `foreignKey` specifies that the values in a column
194+-- (or a group of columns) must match the values appearing in some row of
195+-- another table. We say this maintains the referential integrity
196+-- between two related tables.
197+--
198+-- >>> :set -XOverloadedLabels -XDataKinds
199+-- >>> :{
200+-- let
201+-- definition :: Definition '[]
202+-- '[ "users" :::
203+-- '[ "id" ::: 'Optional ('NotNull 'PGint4)
204+-- , "username" ::: 'Required ('NotNull 'PGtext)
205+-- ]
206+-- , "emails" :::
207+-- '[ "id" ::: 'Optional ('NotNull 'PGint4)
208+-- , "userid" ::: 'Required ('NotNull 'PGint4)
209+-- , "email" ::: 'Required ('NotNull 'PGtext)
210+-- ]
211+-- ]
212+-- definition =
213+-- createTable #users
214+-- (serial `As` #id :* (text & notNull) `As` #username :* Nil)
215+-- [primaryKey (Column #id :* Nil)] >>>
216+-- createTable #emails
217+-- ( serial `As` #id :*
218+-- (integer & notNull) `As` #userid :*
219+-- (text & notNull) `As` #email :* Nil )
220+-- [ primaryKey (Column #id :* Nil)
221+-- , foreignKey (Column #userid :* Nil) #users (Column #id :* Nil)
222+-- OnDeleteCascade OnUpdateRestrict
223+-- ]
224+-- in renderDefinition definition
225+-- :}
226+-- "CREATE TABLE users (id serial, username text NOT NULL, PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, PRIMARY KEY (id), FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"
126227foreignKey
127228 :: ( HasTable reftable schema refcolumns
128229 , SameTypes subcolumns refsubcolumns
@@ -143,10 +244,15 @@ foreignKey columns reftable refcolumns onDelete onUpdate =
143244 <+> renderOnDelete onDelete
144245 <+> renderOnUpdate onUpdate
145246
247+-- | `OnDelete` indicates what to do with rows that reference a deleted row.
146248data OnDelete
147249 = OnDeleteNoAction
148− | OnDeleteRestrict
250+ -- ^ if any referencing rows still exist when the constraint is checked,
251+ -- an error is raised
252+ | OnDeleteRestrict -- ^ prevents deletion of a referenced row
149253 | OnDeleteCascade
254+ -- ^ specifies that when a referenced row is deleted,
255+ -- row(s) referencing it should be automatically deleted as well
150256 deriving (GHC.Generic,Show,Eq,Ord)
151257instance NFData OnDelete
152258
@@ -156,10 +262,16 @@ renderOnDelete = \case
156262 OnDeleteRestrict -> "ON DELETE RESTRICT"
157263 OnDeleteCascade -> "ON DELETE CASCADE"
158264
265+-- | Analagous to `OnDelete` there is also `OnUpdate` which is invoked
266+-- when a referenced column is changed (updated).
159267data OnUpdate
160268 = OnUpdateNoAction
161− | OnUpdateRestrict
269+ -- ^ if any referencing rows has not changed when the constraint is checked,
270+ -- an error is raised
271+ | OnUpdateRestrict -- ^ prevents update of a referenced row
162272 | OnUpdateCascade
273+ -- ^ the updated values of the referenced column(s) should be copied
274+ -- into the referencing row(s)
163275 deriving (GHC.Generic,Show,Eq,Ord)
164276instance NFData OnUpdate
165277