From 93f37507d93bb10ed7f67074c62a478b31f151e3 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 20 Jan 2011 12:43:12 -0500
Subject: queryXI and queryX1I

---
 lib/ur/top.ur | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

(limited to 'lib/ur/top.ur')

diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 0fdbae7a..1edca44e 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -255,6 +255,30 @@ fun queryX [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Ty
           (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 @@ fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
           (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)
-- 
cgit v1.2.3