Mercurial > urweb

changeset 1405:8631e9ed0ee8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
queryXI and queryX1I
author Adam Chlipala <adam@chlipala.net>
date Thu, 20 Jan 2011 12:43:12 -0500
parents 82b204f20026
children e8bea46f8eda
files lib/ur/top.ur lib/ur/top.urs
diffstat 2 files changed, 49 insertions(+), 0 deletions(-) [+]
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)
--- a/lib/ur/top.urs	Thu Jan 20 10:40:40 2011 -0500
+++ b/lib/ur/top.urs	Thu Jan 20 12:43:12 2011 -0500
@@ -164,11 +164,23 @@
                  -> xml ctx inp [])
              -> transaction (xml ctx inp [])
 
+val queryXI : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> (int -> $(exps ++ map (fn fields :: {Type} => $fields) tables)
+        -> xml ctx inp [])
+    -> transaction (xml ctx inp [])
+
 val queryX1 : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
               -> sql_query [] [] [nm = fs] []
               -> ($fs -> xml ctx inp [])
               -> transaction (xml ctx inp [])
 
+val queryX1I : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+               -> sql_query [] [] [nm = fs] []
+               -> (int -> $fs -> xml ctx inp [])
+               -> transaction (xml ctx inp [])
+
 val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
               -> [tables ~ exps] =>
               sql_query [] [] tables exps