Commit 1ffb2b77 authored by Sophie Herold's avatar Sophie Herold 🌼

Adds inquire for table constraint checks

parent 81670959
Pipeline #826 passed with stage
in 3 minutes and 52 seconds
......@@ -78,6 +78,7 @@ deployedTables schema = do
pk <- deployedPrimaryKey (schema, table)
fks <- deployedForeignKeys (schema, table)
uniques <- deployedUniqueConstraints (schema, table)
checks <- deployedTableChecks (schema, table)
return
Table
{ tableName = table
......@@ -86,7 +87,7 @@ deployedTables schema = do
, tablePrimaryKey = pk
, tableUnique = presetEmpty uniques
, tableForeignKeys = presetEmpty fks
, tableChecks = Nothing
, tableChecks = presetEmpty checks
, tableInherits = Nothing
, tablePrivSelect = Nothing
, tablePrivInsert = Nothing
......@@ -138,6 +139,30 @@ deployedColumns tbl = map toColumn <$> psqlQry qry (Only $ toSqlCode tbl)
AND attrelid = ?::regclass::oid
|]
deployedTableChecks :: (SqlName, SqlName) -> SqlT [Check]
deployedTableChecks tbl = do
cons <- psqlQry qry (Only $ toSqlCode tbl)
return $ map toCheck cons
where
toCheck (coname, codesc, cocheck) =
Check
{ checkName = coname
, checkDescription = fromMaybe "" codesc
, checkCheck = cocheck
}
qry =
[sql|
SELECT
conname,
pg_catalog.obj_description(oid, 'pg_constraint')::text AS condesc,
consrc
FROM pg_catalog.pg_constraint
WHERE
contype = 'c'
AND conrelid IS NOT NULL
AND conrelid = ?::regclass::oid
|]
--deployedKeys ::
deployedPrimaryKey :: (SqlName, SqlName) -> SqlT [SqlName]
deployedPrimaryKey tbl = do
......
......@@ -43,14 +43,20 @@ constrId ::
constrId s t c = SqlObj SQL_TABLE_CONSTRAINT (schemaName s, tableName t, c)
-- TODO: prefix with table name
stmtCheck :: ToSqlId a => a -> Check -> Maybe SqlStmt
stmtCheck :: ToSqlId a => a -> Check -> [Maybe SqlStmt]
stmtCheck obj c =
newSqlStmt SqlCreateCheckConstr obj $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
toSqlCode (checkName c) <>
" CHECK (" <>
checkCheck c <>
")"
[ newSqlStmt SqlCreateCheckConstr obj $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
toSqlCode (checkName c) <>
" CHECK (" <>
checkCheck c <>
")"
, newSqlStmt SqlComment obj $
"COMMENT ON CONSTRAINT" <-> toSqlCode (checkName c) <-> "ON" <->
sqlIdCode obj <->
"IS" <->
toSqlCodeString (checkDescription c)
]
instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
toSqlStmts context obj@(SqlContext (schema, table, rawColumn)) =
......@@ -98,7 +104,7 @@ instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
sqlDefault d =
stmtAlterColumn SqlColumnSetDefault $ "SET DEFAULT " <> d
-- [CHECK]
stmtsAddColumnCheck = maybeMap (stmtCheck tbl) (columnChecks c)
stmtsAddColumnCheck = concat $ maybeMap (stmtCheck tbl) (columnChecks c)
-- FOREIGN KEY
stmtAddForeignKey =
case columnReferences c of
......@@ -171,7 +177,7 @@ instance ToSqlStmts (SqlContext (Schema, Table)) where
-- table comment
, stmtCommentOn obj (tableDescription t)
] ++
maybeMap (stmtCheck obj) (tableChecks t) ++
(concat $ maybeMap (stmtCheck obj) (tableChecks t)) ++
-- grant rights to roles
maybeMap (sqlGrant "SELECT") (tablePrivSelect t) ++
maybeMap (sqlGrant "UPDATE") (tablePrivUpdate t) ++
......
......@@ -14,3 +14,11 @@ foreign_keys:
columns: [y1, y2]
ref_table: '"self-test"."X"'
ref_columns: [X3, x1]
checks:
- name: some number checks
description: A check
check: ((y1 > 0) AND (y2 < 0))
- name: trivial
description: This check is trivial.
check: "true"
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment