diff options
author | 2009-09-15 10:18:56 -0400 | |
---|---|---|
committer | 2009-09-15 10:18:56 -0400 | |
commit | 62c16c0eed4b755ffcc4379455971a4c0125a3a8 (patch) | |
tree | b81fba316b6a552d9b1cf527831175d0926da43f /demo | |
parent | 93594385adcba919b2e61785b5a60779e2be20db (diff) |
Summary row with aggregates
Diffstat (limited to 'demo')
-rw-r--r-- | demo/more/dbgrid.ur | 3 | ||||
-rw-r--r-- | demo/more/dbgrid.urs | 1 | ||||
-rw-r--r-- | demo/more/dlist.ur | 19 | ||||
-rw-r--r-- | demo/more/dlist.urs | 1 | ||||
-rw-r--r-- | demo/more/grid.ur | 205 | ||||
-rw-r--r-- | demo/more/grid.urs | 1 | ||||
-rw-r--r-- | demo/more/grid1.ur | 13 | ||||
-rw-r--r-- | demo/more/out/grid.css | 4 |
8 files changed, 153 insertions, 94 deletions
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 <tr class={tr}> <th/> <th/> {foldRX2 [fst] [colMeta M.row] [_] - (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] - data (meta : colMeta M.row p) => - <xml><th class={th}>{[(meta.Handlers data).Header]}</th></xml>) - [_] M.folder grid.Cols M.cols} - </tr> - - {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 - <xml><tr class={tr}> - <td> - <dyn signal={b <- signal ud; + (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] + data (meta : colMeta M.row p) => + <xml><th class={th}>{[(meta.Handlers data).Header]}</th></xml>) + [_] M.folder grid.Cols M.cols} + </tr> + + {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 + <xml><tr class={tr}> + <td> + <dyn signal={b <- signal ud; + return (if b then + <xml><button value="Save" onclick={save}/></xml> + else + <xml><button value="Update" onclick={update}/></xml>)}/> + </td> + + <td><dyn signal={b <- signal ud; return (if b then - <xml><button value="Save" onclick={save}/></xml> + <xml><button value="Cancel" onclick={cancel}/></xml> else - <xml><button value="Update" onclick={update}/></xml>)}/> - </td> - <td><dyn signal={b <- signal ud; - return (if b then - <xml><button value="Cancel" onclick={cancel}/></xml> - else - <xml><button value="Delete" onclick={delete}/></xml>)}/> - </td> - - <dyn signal={cols <- signal colsS; - return (foldRX3 [fst] [colMeta M.row] [snd] [_] - (fn [nm :: Name] [t :: (Type * Type)] - [rest :: {(Type * Type)}] - [[nm] ~ rest] data meta v => - <xml><td class={td}> - <dyn signal={b <- signal ud; - return (if b then - (meta.Handlers data).Edit v - else - (meta.Handlers data).Display - v)}/> - <dyn signal={b <- signal ud; - if b then - valid <- - (meta.Handlers data).Validate v; - return (if valid then - <xml/> - else - <xml>!</xml>) - else - return <xml/>}/> - </td></xml>) - [_] M.folder grid.Cols M.cols cols)}/> - </tr></xml> - end) grid.Rows} + <xml><button value="Delete" onclick={delete}/></xml>)}/> + </td> + + <dyn signal={cols <- signal colsS; + return (foldRX3 [fst] [colMeta M.row] [snd] [_] + (fn [nm :: Name] [t :: (Type * Type)] + [rest :: {(Type * Type)}] + [[nm] ~ rest] data meta v => + <xml><td class={td}> + <dyn signal={b <- signal ud; + return (if b then + (meta.Handlers data).Edit v + else + (meta.Handlers data).Display + v)}/> + <dyn signal={b <- signal ud; + if b then + valid <- + (meta.Handlers data).Validate v; + return (if valid then + <xml/> + else + <xml>!</xml>) + else + return <xml/>}/> + </td></xml>) + [_] M.folder grid.Cols M.cols cols)}/> + </tr></xml> + end) grid.Rows} + + <dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id] + (fn [nm :: Name] [t :: Type] meta acc => + Monad.mp (fn v => meta.Step v acc) + (signal row.Row)) + [_] M.aggFolder M.aggregates) + (mp [aggregateMeta M.row] [id] + (fn [t] meta => meta.Initial) + [_] M.aggFolder M.aggregates) grid.Rows; + return <xml><tr> + <td/><td/> + {foldRX2 [aggregateMeta M.row] [id] [_] + (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc => + <xml><td class={agg}>{meta.Display acc}</td></xml>) + [_] M.aggFolder M.aggregates rows} + </tr></xml>}/> </table> <button value="New row" onclick={row <- rpc M.new; diff --git a/demo/more/grid.urs b/demo/more/grid.urs index 083f458f..a3fd76cc 100644 --- a/demo/more/grid.urs +++ b/demo/more/grid.urs @@ -32,6 +32,7 @@ functor Make(M : sig con aggregates :: {Type} val aggregates : $(map (aggregateMeta row) aggregates) + val aggFolder : folder aggregates end) : sig type grid diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur index 829cf052..edd5858d 100644 --- a/demo/more/grid1.ur +++ b/demo/more/grid1.ur @@ -45,7 +45,18 @@ open Make(struct DA = computed "2A" (fn r => 2 * r.A), Link = computedHtml "Link" (fn r => <xml><a link={page (r.A, r.B)}>Go</a></xml>)} - val aggregates = {} + val aggregates = {Dummy1 = {Initial = (), + Step = fn _ _ => (), + Display = fn _ => <xml/>}, + Sum = {Initial = 0, + Step = fn r n => r.A + n, + Display = txt}, + Dummy2 = {Initial = (), + Step = fn _ _ => (), + Display = fn _ => <xml>-</xml>}, + And = {Initial = True, + Step = fn r b => r.C && b, + Display = txt}} end) fun main () = diff --git a/demo/more/out/grid.css b/demo/more/out/grid.css index 22cfaa06..7903b673 100644 --- a/demo/more/out/grid.css +++ b/demo/more/out/grid.css @@ -13,3 +13,7 @@ .Grid1_td { border-style: solid } + +.Grid1_agg { + border-style: solid +}
\ No newline at end of file |