summaryrefslogtreecommitdiff
path: root/demo/treeFun.ur
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 17:09:53 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 17:09:53 -0500
commit36952b2e49afdb4ba8024eb6372992e4b5d8df7a (patch)
tree16401277a8c24a1bcfcc410700526f64ba27a5b8 /demo/treeFun.ur
parent49f721d39e46ab0635cc2e9a5ed2a66944586640 (diff)
About to begin optimization of recursive transaction functions
Diffstat (limited to 'demo/treeFun.ur')
-rw-r--r--demo/treeFun.ur35
1 files changed, 35 insertions, 0 deletions
diff --git a/demo/treeFun.ur b/demo/treeFun.ur
new file mode 100644
index 00000000..60633695
--- /dev/null
+++ b/demo/treeFun.ur
@@ -0,0 +1,35 @@
+functor Make(M : sig
+ type key
+ con id :: Name
+ con parent :: Name
+ con cols :: {Type}
+ constraint [id] ~ [parent]
+ constraint [id, parent] ~ cols
+
+ val key_inj : sql_injectable key
+ val option_key_inj : sql_injectable (option key)
+
+ table tab : [id = key, parent = option key] ++ cols
+ end) = struct
+
+ open M
+
+ fun tree (f : $([id = key, parent = option key] ++ cols) -> xbody)
+ (root : option M.key) =
+ let
+ fun recurse (root : option key) =
+ queryX' (SELECT * FROM tab WHERE tab.{parent} = {root})
+ (fn r =>
+ children <- recurse (Some r.Tab.id);
+ return <xml>
+ <li> {f r.Tab}</li>
+
+ <ul>
+ {children}
+ </ul>
+ </xml>)
+ in
+ recurse root
+ end
+
+end