changeset 952:07569af40069

Insert dummy Sort parameter
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Sep 2009 14:42:02 -0400
parents 103ac1792c41
children 301530da2062
files demo/more/dlist.ur demo/more/dlist.urs demo/more/grid.ur
diffstat 3 files changed, 38 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/dlist.ur	Thu Sep 17 14:27:00 2009 -0400
+++ b/demo/more/dlist.ur	Thu Sep 17 14:42:02 2009 -0400
@@ -48,7 +48,7 @@
         set tl new;
         return (tailPos cur new tl)
 
-fun render [ctx] [ctx ~ body] [t] f {Filter = filter, ...} dl = <xml>
+fun renderDyn [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter dl = <xml>
   <dyn signal={dl' <- signal dl;
                return (case dl' of
                            Empty => <xml/>
@@ -76,6 +76,39 @@
                            end)}/>
 </xml>
 
+fun renderFlat [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter ls =
+    List.mapX (fn p => f p.1 p.2) ls
+
+fun render [ctx] [ctx ~ body] [t] f r dl = <xml>
+    <dyn signal={sort <- r.Sort;
+                 case sort of
+                     None => return (renderDyn f r.Filter dl)
+                   | Some sort =>
+                     dl' <- signal dl;
+                     elems <- (case dl' of
+                                   Empty => return []
+                                 | Nonempty {Head = hd, Tail = tlTop} =>
+                                   let
+                                       fun listOut prev dl'' acc =
+                                           case dl'' of
+                                               Nil => return acc
+                                             | Cons (v, tl) =>
+                                               let
+                                                   val pos = case prev of
+                                                                 None => headPos dl
+                                                               | Some prev => tailPos prev tl tlTop
+                                               in
+                                                   tl' <- signal tl;
+                                                   listOut (Some tl) tl' ((v, pos) :: acc)
+                                               end
+                                   in
+                                       listOut None hd []
+                                   end);
+                     return (renderFlat f r.Filter elems)}/>
+</xml>
+                             
+        
+
 fun delete pos = pos
 
 fun elements' [t] (dl'' : dlist'' t) =
--- a/demo/more/dlist.urs	Thu Sep 17 14:27:00 2009 -0400
+++ b/demo/more/dlist.urs	Thu Sep 17 14:42:02 2009 -0400
@@ -10,6 +10,7 @@
 
 val render : ctx ::: {Unit} -> [ctx ~ body] => t ::: Type
              -> (t -> position -> xml (ctx ++ body) [] [])
-             -> {Filter : t -> signal bool}
+             -> {Filter : t -> signal bool,
+                 Sort : signal (option (t -> t -> signal bool)) (* <= *)}
              -> dlist t
              -> xml (ctx ++ body) [] []
--- a/demo/more/grid.ur	Thu Sep 17 14:27:00 2009 -0400
+++ b/demo/more/grid.ur	Thu Sep 17 14:42:02 2009 -0400
@@ -212,7 +212,8 @@
                                               this <- (meta.Handlers state).Filter filter row;
                                               return (previous && this))
                                           (fn _ => return True)
-                                          [_] M.folder M.cols grid.Cols grid.Filters row}
+                                          [_] M.folder M.cols grid.Cols grid.Filters row,
+                       Sort = return None}
                       grid.Rows}
 
             <dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id]