diff lib/ur/top.ur @ 1405:8631e9ed0ee8

queryXI and queryX1I
author Adam Chlipala <adam@chlipala.net>
date Thu, 20 Jan 2011 12:43:12 -0500
parents d328983dc5a6
children e8bea46f8eda
line wrap: on
line diff
--- a/lib/ur/top.ur	Thu Jan 20 10:40:40 2011 -0500
+++ b/lib/ur/top.ur	Thu Jan 20 12:43:12 2011 -0500
@@ -255,6 +255,30 @@
           (fn fs acc => return <xml>{acc}{f fs}</xml>)
           <xml/>
 
+fun rev [a] (ls : list a) : list a =
+    let
+        fun rev' ls acc =
+            case ls of
+                [] => acc
+              | x :: ls => rev' ls (x :: acc)
+    in
+        rev' ls []
+    end
+
+fun queryXI [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+            [tables ~ exps] (q : sql_query [] [] tables exps)
+            (f : int -> $(exps ++ map (fn fields :: {Type} => $fields) tables)
+                 -> xml ctx inp []) =
+    let
+        fun qxi ls i =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f i x}{qxi ls (i+1)}</xml>
+    in
+        ls <- queryL q;
+        return (qxi ls 0)
+    end
+
 fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
             (q : sql_query [] [] [nm = fs] [])
             (f : $fs -> xml ctx inp []) =
@@ -262,6 +286,19 @@
           (fn fs acc => return <xml>{acc}{f fs.nm}</xml>)
           <xml/>
 
+fun queryX1I [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+             (q : sql_query [] [] [nm = fs] [])
+             (f : int -> $fs -> xml ctx inp []) =
+    let
+        fun qx1i ls i =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f i x.nm}{qx1i ls (i+1)}</xml>
+    in
+        ls <- queryL q;
+        return (qx1i ls 0)
+    end
+
 fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
             [tables ~ exps] (q : sql_query [] [] tables exps)
             (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)