adamc@944: con colMeta' = fn (row :: Type) (input :: Type) (filter :: Type) => adamc@915: {Header : string, adamc@944: Project : row -> transaction input, adamc@944: Update : row -> input -> transaction row, adamc@944: Display : input -> xbody, adamc@944: Edit : input -> xbody, adamc@944: Validate : input -> signal bool, adamc@944: CreateFilter : transaction filter, adamc@944: DisplayFilter : filter -> xbody, adamc@961: Filter : filter -> row -> signal bool, adamc@961: Sort : option (row -> row -> bool)} adamc@1002: adamc@1002: con colMeta = fn (row :: Type) (global :: Type, input :: Type, filter :: Type) => adamc@1002: {Initialize : transaction global, adamc@1002: Handlers : global -> colMeta' row input filter} adamc@915: adamc@935: con aggregateMeta = fn (row :: Type) (acc :: Type) => adamc@935: {Initial : acc, adamc@935: Step : row -> acc -> acc, adamc@935: Display : acc -> xbody} adamc@935: adamc@915: functor Make(M : sig adamc@915: type row adamc@936: type key adamc@936: val keyOf : row -> key adamc@936: adamc@915: val list : transaction (list row) adamc@915: val new : transaction row adamc@936: val save : key -> row -> transaction unit adamc@936: val delete : key -> transaction unit adamc@915: adamc@944: con cols :: {(Type * Type * Type)} adamc@915: val cols : $(map (colMeta row) cols) adamc@915: adamc@915: val folder : folder cols adamc@935: adamc@935: con aggregates :: {Type} adamc@935: val aggregates : $(map (aggregateMeta row) aggregates) adamc@937: val aggFolder : folder aggregates adamc@964: adamc@964: val pageLength : option int adamc@915: end) = struct adam@1833: style tab adam@1833: style row adam@1833: style header adam@1833: style data adamc@937: style agg adamc@915: adamc@944: fun make (row : M.row) [input] [filter] (m : colMeta' M.row input filter) : transaction input = m.Project row adamc@915: adamc@944: fun makeAll cols row = @@Monad.exec [transaction] _ [map snd3 M.cols] adam@1304: (@map2 [fst3] [colMeta M.row] [fn p => transaction (snd3 p)] adam@1304: (fn [p] data meta => make row (meta.Handlers data)) adam@1304: M.folder cols M.cols) adam@1304: (@@Folder.mp [_] [_] M.folder) adam@1304: adam@1304: type listT = {Row : source M.row, adam@1304: Cols : source ($(map snd3 M.cols)), adam@1304: Updating : source bool, adam@1304: Selected : source bool} adamc@915: adamc@944: type grid = {Cols : $(map fst3 M.cols), adam@1304: Rows : Dlist.dlist listT, adamc@944: Selection : source bool, adamc@960: Filters : $(map thd3 M.cols), adamc@964: Sort : source (option (M.row -> M.row -> bool)), adamc@964: Position : source int} adamc@940: adamc@954: fun newRow cols row = adamc@915: rowS <- source row; adamc@915: cols <- makeAll cols row; adamc@915: colsS <- source cols; adamc@915: ud <- source False; adamc@940: sd <- source False; adamc@954: return {Row = rowS, adamc@954: Cols = colsS, adamc@954: Updating = ud, adamc@954: Selected = sd} adamc@954: adamc@954: fun addRow cols rows row = adamc@954: r <- newRow cols row; adamc@954: Monad.ignore (Dlist.append rows r) adamc@915: adamc@944: val grid = adamc@1093: cols <- @Monad.mapR _ [colMeta M.row] [fst3] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] meta => meta.Initialize) adamc@1093: M.folder M.cols; adamc@915: adamc@1093: filters <- @Monad.mapR2 _ [colMeta M.row] [fst3] [thd3] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] meta state => adamc@1093: (meta.Handlers state).CreateFilter) adamc@1093: M.folder M.cols cols; adamc@944: adamc@951: rows <- Dlist.create; adamc@940: sel <- source False; adamc@960: sort <- source None; adamc@964: pos <- source 0; adamc@951: adamc@951: return {Cols = cols, adamc@951: Rows = rows, adamc@951: Selection = sel, adamc@960: Filters = filters, adamc@964: Sort = sort, adamc@964: Position = pos} adamc@915: adamc@940: fun sync {Cols = cols, Rows = rows, ...} = adamc@915: Dlist.clear rows; adamc@915: init <- rpc M.list; adamc@954: rs <- List.mapM (newRow cols) init; adamc@954: Dlist.replace rows rs adamc@915: adamc@965: fun myFilter grid all = adamc@965: row <- signal all.Row; adamc@1093: @foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] adamc@1093: [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@1093: meta state filter combinedFilter row => adamc@1093: previous <- combinedFilter row; adamc@1093: this <- (meta.Handlers state).Filter filter row; adamc@1093: return (previous && this)) adamc@1093: (fn _ => return True) adamc@1093: M.folder M.cols grid.Cols grid.Filters row adamc@965: adamc@961: fun render (grid : grid) = adam@1833: adam@1833: adam@1784: adam@1641: {@mapX2 [fst3] [colMeta M.row] [tr] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@1093: data (meta : colMeta M.row p) => adam@1833: ) adamc@1093: M.folder grid.Cols M.cols} adamc@937: adamc@915: adamc@940: {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud, Selected = sd} pos => adamc@937: let adamc@937: val delete = adamc@937: Dlist.delete pos; adamc@937: row <- get rowS; adamc@937: rpc (M.delete (M.keyOf row)) adamc@915: adamc@937: val update = set ud True adamc@915: adamc@937: val cancel = adamc@937: set ud False; adamc@937: row <- get rowS; adamc@937: cols <- makeAll grid.Cols row; adamc@937: set colsS cols adamc@937: adamc@937: val save = adamc@937: cols <- get colsS; adamc@1093: errors <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => option string] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] adamc@1093: [[nm] ~ rest] data meta v errors => adamc@1093: b <- current ((meta.Handlers data).Validate v); adamc@1093: return (if b then adamc@1093: errors adamc@1093: else adamc@1093: case errors of adamc@1093: None => Some ((meta.Handlers data).Header) adamc@1093: | Some s => Some ((meta.Handlers data).Header adamc@1093: ^ ", " ^ s))) adamc@1093: None M.folder grid.Cols M.cols cols; adamc@915: adamc@937: case errors of adamc@937: Some s => alert ("Can't save because the following columns have invalid values:\n" adamc@937: ^ s) adamc@937: | None => adamc@937: set ud False; adamc@937: row <- get rowS; adamc@1093: row' <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => M.row] adamc@1093: (fn [nm :: Name] [t :: (Type * Type * Type)] adamc@1093: [rest :: {(Type * Type * Type)}] adamc@1093: [[nm] ~ rest] data meta v row' => adamc@1093: (meta.Handlers data).Update row' v) adamc@1093: row M.folder grid.Cols M.cols cols; adamc@937: rpc (M.save (M.keyOf row) row'); adamc@937: set rowS row'; adamc@937: adamc@937: cols <- makeAll grid.Cols row'; adamc@937: set colsS cols adamc@937: in adam@1833: adamc@937: adamc@940: adamc@940: adamc@937: adamc@937: adamc@937: adamc@937: adam@1833: ) adamc@1093: M.folder grid.Cols M.cols cols)}/> adamc@937: adamc@951: end) adamc@965: {StartPosition = case M.pageLength of adamc@965: None => return None adamc@965: | Some len => adamc@965: avail <- Dlist.numPassing (myFilter grid) grid.Rows; adamc@965: pos <- signal grid.Position; adamc@965: return (Some (if pos >= avail then adamc@965: 0 adamc@965: else adamc@965: pos)), adamc@964: MaxLength = return M.pageLength, adamc@965: Filter = myFilter grid, adamc@960: Sort = f <- signal grid.Sort; adamc@960: return (Option.mp (fn f r1 r2 => r1 <- signal r1.Row; adamc@960: r2 <- signal r2.Row; adamc@960: return (f r1 r2)) f)} adamc@951: grid.Rows} adamc@915: adam@1304: adam@1649: @Monad.mapR2 _ [aggregateMeta M.row] [ident] [ident] adam@1304: (fn [nm :: Name] [t :: Type] meta acc => adam@1304: Monad.mp (fn v => meta.Step v acc) adam@1304: (signal row.Row)) adam@1304: M.aggFolder M.aggregates) adam@1649: (@mp [aggregateMeta M.row] [ident] adamc@937: (fn [t] meta => meta.Initial) adamc@1093: M.aggFolder M.aggregates) grid.Rows; adamc@937: return adamc@941: adam@1649: {@mapX2 [aggregateMeta M.row] [ident] [_] adamc@1093: (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc => adamc@1093: ) adamc@1093: M.aggFolder M.aggregates rows} adamc@937: }/> adamc@944: adamc@944: adamc@1172: {@mapX3 [colMeta M.row] [fst3] [thd3] [_] adamc@1093: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@1093: meta state filter => ) adamc@1093: M.folder M.cols grid.Cols grid.Filters} adamc@944: adamc@915:
adamc@1093: {case (meta.Handlers data).Sort of adamc@1093: None => txt (meta.Handlers data).Header adamc@1093: | sort =>
adamc@940: adamc@940: else adamc@941: )}/> adamc@940: adamc@937: adamc@1093: adamc@1093: adamc@1093: else adamc@1093: !) adamc@1093: else adamc@1093: return }/> adamc@1093:
Aggregates{meta.Display acc}
Filters{(meta.Handlers state).DisplayFilter filter}
adamc@964: adamc@964: {case M.pageLength of adamc@964: None => adamc@964: | Some plen => adamc@965: adamc@964: else adamc@964: let adamc@964: val numPages = avail / plen adamc@964: val numPages = if numPages * plen < avail then adamc@964: numPages + 1 adamc@964: else adamc@964: numPages adamc@964: adamc@964: fun pages n = adamc@964: if n * plen >= avail then adamc@964: adamc@964: else adamc@964: adamc@964: {[n + 1]} adamc@964: else adamc@964: adamc@964: