diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-11-06 17:09:53 -0500 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-06 17:09:53 -0500 |
commit | 98d669cf07157e275fa796fdd5ad35f3388b0ad1 (patch) | |
tree | 16401277a8c24a1bcfcc410700526f64ba27a5b8 /demo/treeFun.ur | |
parent | 5b41c32b3fb60944fd5d342f7f6ee4413510b9f5 (diff) |
About to begin optimization of recursive transaction functions
Diffstat (limited to 'demo/treeFun.ur')
-rw-r--r-- | demo/treeFun.ur | 35 |
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 |