Commit 74e79125 authored by Sophie Herold's avatar Sophie Herold 🌼

Adds support to inquire domain constraints

parent 1567ee2b
Pipeline #819 passed with stage
in 4 minutes and 1 second
......@@ -283,16 +283,18 @@ deployedFunctions schema = do
deployedDomains :: SqlName -> SqlT [Domain]
deployedDomains schema = do
doms <- psqlQry qry (Only $ toSqlCode schema)
return $ map toDomain doms
mapM toDomain doms
where
toDomain (domname, domdesc, domtype, domdefault) =
Domain
{ domainName = domname
, domainDescription = fromMaybe "" domdesc
, domainType = domtype
, domainDefault = domdefault
, domainChecks = Nothing -- Maybe [Check]
}
toDomain (domname, domdesc, domtype, domdefault) = do
constraints <- deployedDomainConstraints (schema, domname)
return $
Domain
{ domainName = domname
, domainDescription = fromMaybe "" domdesc
, domainType = domtype
, domainDefault = domdefault
, domainChecks = presetEmpty constraints
}
qry =
[sql|
SELECT
......@@ -306,6 +308,29 @@ deployedDomains schema = do
AND typnamespace = ?::regnamespace::oid
|]
deployedDomainConstraints :: (SqlName, SqlName) -> SqlT [Check]
deployedDomainConstraints dom = do
cons <- psqlQry qry (Only $ toSqlCode dom)
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(c.oid, 'pg_constraint')::text AS condesc,
consrc
FROM pg_catalog.pg_constraint c
JOIN pg_type t ON t.oid = contypid
WHERE
t.oid = ?::regtype::oid
|]
sqlManageSchemaJoin :: Text -> Text
sqlManageSchemaJoin schemaid =
" JOIN pg_namespace AS n " <\> " ON" <-> schemaid <-> "= n.oid AND " <\>
......
......@@ -22,11 +22,19 @@ instance ToSqlStmts (SqlContext (Schema, Domain)) where
toSqlStmts _ obj@(SqlContext (_, d)) =
stmtCreateDomain :
sqlDefault (domainDefault d) :
stmtCommentOn obj (domainDescription d) : maybeMap sqlCheck (domainChecks d)
stmtCommentOn obj (domainDescription d) :
(maybeMap sqlCheck (domainChecks d) ++
maybeMap checkComment (domainChecks d))
where
stmtCreateDomain =
newSqlStmt SqlCreateDomain obj $
"CREATE DOMAIN" <-> sqlIdCode obj <-> "AS" <-> toSqlCode (domainType d)
checkComment c =
newSqlStmt SqlComment obj $
"COMMENT ON CONSTRAINT" <-> toSqlCode (checkName c) <-> "ON DOMAIN" <->
sqlIdCode obj <->
"IS" <->
toSqlCodeString (checkDescription c)
sqlCheck :: Check -> Maybe SqlStmt
sqlCheck c =
newSqlStmt SqlCreateCheckConstr obj $
......
name: t_mydomain
description: My Domain
type: character varying(30)
checks:
- name: Only one value allowed
description: Only the value 'test1' is allowed
check: "((VALUE)::text = 'test1'::text)"
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