/src-extra/extensions/Database/HsSqlPpp/Extensions/CreateAssertion.lhs

  1
  2sketch
  3------
  4
  5something like an implementation of the rarely implemented create
  6assertion sql syntax
  7
  8The basic approach is to analyze the constraint expression to get a
  9list of ultimately reference tables, then:
 10
 11create a check function which returns a bool to say whether the
 12expression is true,
 13
 14create a trigger and trigger function for each table which calls all
 15the check functions who reference this table and raise if any are
 16false
 17
 18when we add a constraint which references a table with an existing
 19constraint, we add the new check function, and create or replace the
 20trigger function with the new check function added to the existing
 21ones, which avoids having to also drop and create the trigger
 22
 23could add an optimisation to say that if there are no crud statements
 24inbetween two constraints, we can skip creating the first trigger
 25function, and change create or replace to create on the second one,
 26and move the add trigger down. Also - want to try to limit any crud to
 27using the table values extension, which may be relevant to this.
 28
 29todo/ issues
 30------------
 31
 32add catalog entries. not null and key constrainsts are part of a
 33table, but the regular check and foreign key constraints possibly
 34could appear in assertion catalog along with the constraints added by
 35this extension
 36
 37the logic which determines which tables are referenced by an
 38expression is a bit dodgy: it only copes with all the create
 39assertions being set in one ast, so we can load one file, then load
 40another file later and it do the right thing.
 41
 42this logic is also wrong for functions - it doesn't take into account
 43function overloading, to fix this need to type check to determine
 44which exact functions are called, might be a bit tricky, since we run
 45extensions on asts which only neccessarily type check after all the
 46extensions have been applied.
 47
 48Since pg has no multiple updates, some sort of hack may be needed for
 49some updates in combination with some constraints.
 50
 51I'm pretty sure the constraint system works fine as long as
 52* you never change the columns on a table after adding a constraint
 53* you only add constraints, never change or remove them
 54* all database transactions are run one at a time, serialised
 55  (actually serialised, not just using sql isolation serializable).
 56
 57If any of these assumptions are broken, you might break your database,
 58load bad data in or get weird errors for stuff that should work.
 59
 60foreign keys without having to create a view first i.e. a literal
 61view expression in the constraint.
 62
 63alternative key syntax to remove the distinction between primary key
 64and unique not null?
 65
 66could add support for check constraints referring to multiple rows in
 67same table? don't want to allow check constraints which refer to other
 68tables. Maybe go further: following tutorial d, only allow key and not
 69null constraints in create table or alter table, and move chek and
 70foreign keys out to create assertions or shorthand wrappers? Inline
 71constraints can be more readable though?
 72
 73maybe add a parser extension to parse:
 74
 75    create assertion constraint_name check(expression);
 76
 77add some syntax to say:
 78not too sure about how this all works, write a seperate bunch of
 79code to read all the constraints either out of the catalog or from the
 80source, then use the final version of the sql code, type check it, and
 81use the type check information to check all the constraints seem to
 82have been added ok.
 83
 84* here are some example sets of relation values which should be
 85  accepted by the constraint
 86* here are some which should not be accepted by the constraint
 87
 88and have a way to check these (this stuff goes in the client program
 89using the constraints).
 90
 91add supplemental expressions for error reporting: so instead of
 92  saying x constraint failed, can run through the expressions one at a
 93  time and when one passes or fails or something can give a more
 94  useful error message depending on how it failed.
 95
 96~~~~
 97=== ghetto test thing
 98want to write some tests for this constraint system just as a sanity
 99check for now:
100arbitrary check e.g. cardinality < 5
101arbitrary check multiple tables e.g. sum cardinality of two tables
102check without acceleration?:
103fk
104fk to view
105unique
106x,y in board size range from another table
107
108for each check:
109check adding constraint to invalid tables throws
110check adding constraint to valid tables OK
111insert OK data into constrained tables
112insert bad data into constrained tables
113
114accelerated checks
115fk to view
116x,y in board size range
117check acceleration for normal checks & fk without pg?
118
119pg accelerated checks:
120just check pg catalog to see if inserted
121check
122fk
123unique
124
125all todo: yes, that means there is no direct testing of any of the
126constraint stuff...
127~~~~~
128
129not too sure about how this all works, write a seperate bunch of
130code to read all the constraints either out of the catalog or from the
131source, then use the final version of the sql code, type check it, and
132use the type check information to check all the constraints seem to
133have been added ok.
134
135----------------------------
136
137Tests/examples in CreateAssertionTests.lhs
138
139> {-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TupleSections #-}
140>
141> module Database.HsSqlPpp.Extensions.CreateAssertion
142>     (createAssertion) where
143>
144> --import Data.Generics
145> import Data.Generics.Uniplate.Data
146> --import Debug.Trace
147> import Control.Monad.State
148> import Data.Maybe
149>
150> import Database.HsSqlPpp.Ast
151> import Database.HsSqlPpp.Parser
152> import Database.HsSqlPpp.Utils.Utils
153> import Database.HsSqlPpp.Quote
154> import Database.HsSqlPpp.Extensions.AstUtils
155> import Database.HsSqlPpp.Annotation
156
157implementation
158==============
159
160when we go through, need to record the constraints we've already
161seen. using transformBiM with state monad, gives us the constraints in
162reverse order of the statement list, so chuck three reverses in there
163to make it work right.
164
165> createAssertion :: [Statement] -> [Statement]
166> createAssertion ast = reverse $
167>  (\f -> evalState (transformBiM f (reverse ast)) ([] :: ConstraintRecord)) $ \x ->
168>       case x of
169>         s@[sqlStmt| select create_assertion($s(name)
170>                                           ,$s(exprtext));|] : tl -> do
171>             existing <- get
172>             let (new, rast) = makeConstraintDdl existing name exprtext
173>             put new
174>             return $ replaceSourcePos s rast ++ tl
175>         x1 -> return x1
176>  where
177>    asti = getAstInfo ast
178>    makeConstraintDdl :: ConstraintRecord -> String -> String -> (ConstraintRecord, [Statement])
179>    makeConstraintDdl cons name exprText =
180>      let expr = either (error . show) id
181>                   $ parseScalarExpr "" exprText
182>      in (newcons cons (tableNames expr) name
183>         ,reverse (makeCheckFn name expr : extras cons name expr))
184>    extras :: ConstraintRecord -> String -> ScalarExpr -> [Statement]
185>    extras cons name expr = flip concatMap (tableNames expr) $ \tn ->
186>                  let ec = existingConstraints tn cons
187>                  in if null ec
188>                     then [makeTriggerFn False tn [name]
189>                          ,makeTrigger tn]
190>                     else [makeTriggerFn True tn (name:ec)]
191>    tableNames expr = let y = getReferencedTableList asti expr
192>                      in y
193>    newcons cons tns nm = foldr (uncurry (insertWith (++))) cons (map (,[nm]) tns)
194>    existingConstraints tn cons = fromMaybe [] $ lookup tn cons
195>
196> type ConstraintRecord = [(String,[String])] -- tablename, list of constraint names
197>
198> makeCheckFn :: String -> ScalarExpr -> Statement
199> makeCheckFn name expr =
200>     let checkfn = "check_con_" ++ name
201>     in [sqlStmt|
202>              create function $(checkfn)() returns bool as $xxx$
203>              begin
204>                return $(expr);
205>              end;
206>              $xxx$ language plpgsql stable;
207>            |]
208>
209> makeTriggerFn :: Bool -> String -> [String] -> Statement
210> makeTriggerFn r tn nms =
211>   let trigopname = tn ++ "_constraint_trigger_operator"
212>       ifs :: [Statement]
213>       ifs = map makeIf nms
214>       -- using template approach cos can't get antistatement -> [statement] working
215>       template = [sqlStmt|
216>                   create function $(trigopname)() returns trigger as $xxx$
217>                   begin
218>                     null;
219>                     return OLD;
220>                   end;
221>                   $xxx$ language plpgsql stable;
222>                   |]
223>       rep = if r
224>             then transformBi $ \x ->
225>                    case x of
226>                           NoReplace -> Replace
227>                           x1 -> x1
228>             else id
229>   in flip transformBi (rep template) $ \x ->
230>        case x of
231>              NullStatement _ : tl -> ifs ++ tl
232>              x1 -> x1
233>   where
234>     makeIf nm = let chk = "check_con_" ++ nm
235>                     errMsg = "update violates database constraint " ++ nm
236>                 in [pgsqlStmt|
237>                    if not $(chk)() then
238>                       raise exception '$(errMsg)';
239>                    end if;
240>                    |]
241>
242> makeTrigger :: String -> Statement
243> makeTrigger tn = let trigname = tn ++ "_constraint_trigger"
244>                      opname = tn ++ "_constraint_trigger_operator"
245>                  in [sqlStmt|
246>   create trigger $(trigname)
247>     after insert or update or delete on $(tn)
248>     for each statement
249>     execute procedure $(opname)();
250>                        |]