summaryrefslogtreecommitdiff
path: root/demo
diff options
context:
space:
mode:
Diffstat (limited to 'demo')
-rw-r--r--demo/more/dlist.ur55
-rw-r--r--demo/more/grid.ur2
2 files changed, 52 insertions, 5 deletions
diff --git a/demo/more/dlist.ur b/demo/more/dlist.ur
index 244c54a7..a8c464a6 100644
--- a/demo/more/dlist.ur
+++ b/demo/more/dlist.ur
@@ -79,11 +79,57 @@ fun renderDyn [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) []
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
+val split [t] =
+ let
+ fun split' acc (ls : list t) =
+ case ls of
+ [] => acc
+ | x1 :: [] => (x1 :: acc.1, acc.2)
+ | x1 :: x2 :: ls => split' (x1 :: acc.1, x2 :: acc.2) ls
+ in
+ split' ([], [])
+ end
+
+fun merge [t] (cmp : t -> t -> signal bool) =
+ let
+ fun merge' acc (ls1 : list t) (ls2 : list t) =
+ case (ls1, ls2) of
+ ([], _) => return (List.revAppend acc ls2)
+ | (_, []) => return (List.revAppend acc ls1)
+ | (x1 :: ls1', x2 :: ls2') =>
+ b <- cmp x1 x2;
+ if b then
+ merge' (x1 :: acc) ls1' ls2
+ else
+ merge' (x2 :: acc) ls1 ls2'
+ in
+ merge' []
+ end
+
+fun sort [t] (cmp : t -> t -> signal bool) =
+ let
+ fun sort' (ls : list t) =
+ case ls of
+ [] => return ls
+ | _ :: [] => return ls
+ | _ =>
+ let
+ val (ls1, ls2) = split ls
+ in
+ ls1' <- sort' ls1;
+ ls2' <- sort' ls2;
+ merge cmp ls1' ls2'
+ end
+ in
+ sort'
+ end
+
+fun render [ctx] [ctx ~ body] [t] f (r : {Filter : t -> signal bool,
+ Sort : signal (option (t -> t -> signal bool))}) dl = <xml>
+ <dyn signal={cmp <- r.Sort;
+ case cmp of
None => return (renderDyn f r.Filter dl)
- | Some sort =>
+ | Some cmp =>
dl' <- signal dl;
elems <- (case dl' of
Empty => return []
@@ -104,6 +150,7 @@ fun render [ctx] [ctx ~ body] [t] f r dl = <xml>
in
listOut None hd []
end);
+ elems <- sort (fn v1 v2 => cmp v1.1 v2.1) elems;
return (renderFlat f r.Filter elems)}/>
</xml>
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index a59e1082..2b451456 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -213,7 +213,7 @@ functor Make(M : sig
return (previous && this))
(fn _ => return True)
[_] M.folder M.cols grid.Cols grid.Filters row,
- Sort = return None}
+ Sort = return (Some (fn _ _ => return False))}
grid.Rows}
<dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id]