diff options
author | Benjamin Barenblat <bbaren@mit.edu> | 2017-07-23 09:50:04 -0400 |
---|---|---|
committer | Benjamin Barenblat <bbaren@mit.edu> | 2017-07-23 09:50:04 -0400 |
commit | 0cccdb0ae595cd7e3e136e984ac7b95b99f71a53 (patch) | |
tree | 491d3b13813610943c60460d3e178d3a73916346 /demo/treeFun.ur |
Import urweb_20170720+dfsg.orig.tar.gz
[dgit import orig urweb_20170720+dfsg.orig.tar.gz]
Diffstat (limited to 'demo/treeFun.ur')
-rw-r--r-- | demo/treeFun.ur | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/demo/treeFun.ur b/demo/treeFun.ur new file mode 100644 index 0000000..2d4ef73 --- /dev/null +++ b/demo/treeFun.ur @@ -0,0 +1,34 @@ +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_prim 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 {eqNullable' (SQL 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 |