From 44eb43907a88455c0cf223a411860a27d59c78b6 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Tue, 15 Sep 2009 10:18:56 -0400 Subject: Summary row with aggregates --- demo/more/dbgrid.ur | 3 + demo/more/dbgrid.urs | 1 + demo/more/dlist.ur | 19 +++++ demo/more/dlist.urs | 1 + demo/more/grid.ur | 205 +++++++++++++++++++++++++++---------------------- demo/more/grid.urs | 1 + demo/more/grid1.ur | 13 +++- demo/more/out/grid.css | 4 + 8 files changed, 153 insertions(+), 94 deletions(-) (limited to 'demo') diff --git a/demo/more/dbgrid.ur b/demo/more/dbgrid.ur index deefd4f1..04eb6dc5 100644 --- a/demo/more/dbgrid.ur +++ b/demo/more/dbgrid.ur @@ -251,6 +251,7 @@ functor Make(M : sig con aggregates :: {Type} val aggregates : $(map (aggregateMeta (key ++ row)) aggregates) + val aggFolder : folder aggregates end) = struct open Grid.Make(struct fun keyOf r = r --- M.row @@ -297,5 +298,7 @@ functor Make(M : sig val folder = M.colsFolder val aggregates = M.aggregates + + val aggFolder = M.aggFolder end) end diff --git a/demo/more/dbgrid.urs b/demo/more/dbgrid.urs index 908f4b2a..e715542b 100644 --- a/demo/more/dbgrid.urs +++ b/demo/more/dbgrid.urs @@ -103,6 +103,7 @@ functor Make(M : sig con aggregates :: {Type} val aggregates : $(map (aggregateMeta (key ++ row)) aggregates) + val aggFolder : folder aggregates end) : sig type grid diff --git a/demo/more/dlist.ur b/demo/more/dlist.ur index f8aca1e2..850836b0 100644 --- a/demo/more/dlist.ur +++ b/demo/more/dlist.ur @@ -86,3 +86,22 @@ fun elements [t] (dl : dlist t) = case dl' of Empty => return [] | Nonempty {Head = hd, ...} => elements' hd + +fun foldl [t] [acc] (f : t -> acc -> signal acc) = + let + fun foldl'' (i : acc) (dl : dlist'' t) : signal acc = + case dl of + Nil => return i + | Cons (v, dl') => + dl' <- signal dl'; + i' <- f v i; + foldl'' i' dl' + + fun foldl' (i : acc) (dl : dlist t) : signal acc = + dl <- signal dl; + case dl of + Empty => return i + | Nonempty {Head = dl, ...} => foldl'' i dl + in + foldl' + end diff --git a/demo/more/dlist.urs b/demo/more/dlist.urs index 872dabcd..fcfe15ee 100644 --- a/demo/more/dlist.urs +++ b/demo/more/dlist.urs @@ -6,6 +6,7 @@ val clear : t ::: Type -> dlist t -> transaction unit val append : t ::: Type -> dlist t -> t -> transaction position val delete : position -> transaction unit val elements : t ::: Type -> dlist t -> signal (list t) +val foldl : t ::: Type -> acc ::: Type -> (t -> acc -> signal acc) -> acc -> dlist t -> signal acc val render : ctx ::: {Unit} -> [ctx ~ body] => t ::: Type -> (t -> position -> xml (ctx ++ body) [] []) diff --git a/demo/more/grid.ur b/demo/more/grid.ur index cb836970..7e593791 100644 --- a/demo/more/grid.ur +++ b/demo/more/grid.ur @@ -32,11 +32,13 @@ functor Make(M : sig con aggregates :: {Type} val aggregates : $(map (aggregateMeta row) aggregates) + val aggFolder : folder aggregates end) = struct style tabl style tr style th style td + style agg fun make (row : M.row) [t] (m : colMeta' M.row t) : transaction t = m.Project row @@ -77,101 +79,118 @@ functor Make(M : sig {foldRX2 [fst] [colMeta M.row] [_] - (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] - data (meta : colMeta M.row p) => - {[(meta.Handlers data).Header]}) - [_] M.folder grid.Cols M.cols} - - - {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos => - let - val delete = - Dlist.delete pos; - row <- get rowS; - rpc (M.delete (M.keyOf row)) - - val update = set ud True - - val cancel = - set ud False; - row <- get rowS; - cols <- makeAll grid.Cols row; - set colsS cols - - val save = - cols <- get colsS; - errors <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => option string] - (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] - [[nm] ~ rest] data meta v errors => - b <- current ((meta.Handlers data).Validate v); - return (if b then - errors - else - case errors of - None => Some ((meta.Handlers data).Header) - | Some s => Some ((meta.Handlers data).Header - ^ ", " ^ s))) - None [_] M.folder grid.Cols M.cols cols; - - case errors of - Some s => alert ("Can't save because the following columns have invalid values:\n" - ^ s) - | None => - set ud False; - row <- get rowS; - row' <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => M.row] - (fn [nm :: Name] [t :: (Type * Type)] - [rest :: {(Type * Type)}] - [[nm] ~ rest] data meta v row' => - (meta.Handlers data).Update row' v) - row [_] M.folder grid.Cols M.cols cols; - rpc (M.save (M.keyOf row) row'); - set rowS row'; - - cols <- makeAll grid.Cols row'; - set colsS cols - in - - - + {[(meta.Handlers data).Header]}) + [_] M.folder grid.Cols M.cols} + + + {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos => + let + val delete = + Dlist.delete pos; + row <- get rowS; + rpc (M.delete (M.keyOf row)) + + val update = set ud True + + val cancel = + set ud False; + row <- get rowS; + cols <- makeAll grid.Cols row; + set colsS cols + + val save = + cols <- get colsS; + errors <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => option string] + (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] + [[nm] ~ rest] data meta v errors => + b <- current ((meta.Handlers data).Validate v); + return (if b then + errors + else + case errors of + None => Some ((meta.Handlers data).Header) + | Some s => Some ((meta.Handlers data).Header + ^ ", " ^ s))) + None [_] M.folder grid.Cols M.cols cols; + + case errors of + Some s => alert ("Can't save because the following columns have invalid values:\n" + ^ s) + | None => + set ud False; + row <- get rowS; + row' <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => M.row] + (fn [nm :: Name] [t :: (Type * Type)] + [rest :: {(Type * Type)}] + [[nm] ~ rest] data meta v row' => + (meta.Handlers data).Update row' v) + row [_] M.folder grid.Cols M.cols cols; + rpc (M.save (M.keyOf row) row'); + set rowS row'; + + cols <- makeAll grid.Cols row'; + set colsS cols + in + + +