Mercurial > urweb
comparison demo/treeFun.ur @ 469:b393c2fc80f8
About to begin optimization of recursive transaction functions
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 06 Nov 2008 17:09:53 -0500 |
parents | |
children | 7cb418e9714f |
comparison
equal
deleted
inserted
replaced
468:4efab85405be | 469:b393c2fc80f8 |
---|---|
1 functor Make(M : sig | |
2 type key | |
3 con id :: Name | |
4 con parent :: Name | |
5 con cols :: {Type} | |
6 constraint [id] ~ [parent] | |
7 constraint [id, parent] ~ cols | |
8 | |
9 val key_inj : sql_injectable key | |
10 val option_key_inj : sql_injectable (option key) | |
11 | |
12 table tab : [id = key, parent = option key] ++ cols | |
13 end) = struct | |
14 | |
15 open M | |
16 | |
17 fun tree (f : $([id = key, parent = option key] ++ cols) -> xbody) | |
18 (root : option M.key) = | |
19 let | |
20 fun recurse (root : option key) = | |
21 queryX' (SELECT * FROM tab WHERE tab.{parent} = {root}) | |
22 (fn r => | |
23 children <- recurse (Some r.Tab.id); | |
24 return <xml> | |
25 <li> {f r.Tab}</li> | |
26 | |
27 <ul> | |
28 {children} | |
29 </ul> | |
30 </xml>) | |
31 in | |
32 recurse root | |
33 end | |
34 | |
35 end |