on dev help sign in
type safe foreign and primary keys
8945616Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+7−3
@@ -286,7 +286,8 @@ unique columns = UnsafeTableConstraintExpression $
286-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"
286-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"
287primaryKey
287primaryKey
288 :: ( Has alias schema table
288 :: ( Has alias schema table
289− , HasAll aliases (TableToColumns table) subcolumns )
289+ , HasAll aliases (TableToColumns table) subcolumns
290+ , AllNotNull subcolumns )
290 => NP Alias aliases
291 => NP Alias aliases
291 -> TableConstraintExpression schema alias ('PrimaryKey aliases)
292 -> TableConstraintExpression schema alias ('PrimaryKey aliases)
292primaryKey columns = UnsafeTableConstraintExpression $
293primaryKey columns = UnsafeTableConstraintExpression $
@@ -337,8 +338,11 @@ foreignKey
337 :: ( Has child schema table
338 :: ( Has child schema table
338 , Has parent schema reftable
339 , Has parent schema reftable
339 , HasAll columns (TableToColumns table) tys
340 , HasAll columns (TableToColumns table) tys
340− , HasAll refcolumns (TableToColumns reftable) reftys
341+ , reftable ~ (constraints :=> cols)
342+ , HasAll refcolumns cols reftys
341− , SOP.AllZip SamePGType tys reftys )
343+ , SOP.AllZip SamePGType tys reftys
344+ , AllNotNull reftys
345+ , Uniquely refcolumns constraints )
342 => NP Alias columns
346 => NP Alias columns
343 -- ^ column or columns in the table
347 -- ^ column or columns in the table
344 -> Alias parent
348 -> Alias parent
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+8
@@ -56,6 +56,7 @@ module Squeal.PostgreSQL.Schema
56 , TableConstraint (..)
56 , TableConstraint (..)
57 , TableConstraints
57 , TableConstraints
58 , NilTableConstraints
58 , NilTableConstraints
59+ , Uniquely
59 -- * Aliases
60 -- * Aliases
60 , (:::)
61 , (:::)
61 , Alias (Alias)
62 , Alias (Alias)
@@ -248,6 +249,13 @@ type TableConstraints = [(Symbol,TableConstraint)]
248type family NilTableConstraints :: TableConstraints where
249type family NilTableConstraints :: TableConstraints where
249 NilTableConstraints = '[]
250 NilTableConstraints = '[]
250
251
252+type family Uniquely
253+ (keys :: [Symbol])
254+ (constraints :: TableConstraints) :: Constraint where
255+ Uniquely keys (uq ::: 'Unique keys ': constraints) = ()
256+ Uniquely keys (uq ::: 'PrimaryKey keys ': constraints) = ()
257+ Uniquely keys (_ ': constraints) = Uniquely keys constraints
258+
251-- | `TableType` encodes a row of constraints on a table as well as the types
259-- | `TableType` encodes a row of constraints on a table as well as the types
252-- of its columns.
260-- of its columns.
253--
261--