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@944: Filter : filter -> row -> signal bool} adamc@944: adamc@944: con colMeta = fn (row :: Type) (global_input_filter :: (Type * Type * Type)) => adamc@944: {Initialize : transaction global_input_filter.1, adamc@944: Handlers : global_input_filter.1 -> colMeta' row global_input_filter.2 global_input_filter.3} 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@915: end) = struct adamc@915: style tabl adamc@915: style tr adamc@915: style th adamc@915: style td 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] adamc@944: (map2 [fst3] [colMeta M.row] [fn p => transaction (snd3 p)] adamc@944: (fn [p] data meta => make row [_] [_] (meta.Handlers data)) adamc@915: [_] M.folder cols M.cols) adamc@915: (@@Folder.mp [_] [_] M.folder) adamc@915: adamc@944: type grid = {Cols : $(map fst3 M.cols), adamc@940: Rows : Dlist.dlist {Row : source M.row, adamc@944: Cols : source ($(map snd3 M.cols)), adamc@940: Updating : source bool, adamc@940: Selected : source bool}, adamc@944: Selection : source bool, adamc@944: Filters : $(map thd3 M.cols)} 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@944: cols <- Monad.mapR [colMeta M.row] [fst3] adamc@944: (fn [nm :: Name] [p :: (Type * Type * Type)] meta => meta.Initialize) adamc@944: [_] M.folder M.cols; adamc@915: adamc@944: filters <- Monad.mapR2 [colMeta M.row] [fst3] [thd3] adamc@944: (fn [nm :: Name] [p :: (Type * Type * Type)] meta state => adamc@944: (meta.Handlers state).CreateFilter) adamc@944: [_] M.folder M.cols cols; adamc@944: adamc@951: rows <- Dlist.create; adamc@940: sel <- source False; adamc@951: adamc@951: return {Cols = cols, adamc@951: Rows = rows, adamc@951: Selection = sel, adamc@951: Filters = filters} 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@915: fun render grid = adamc@915: adamc@915: adamc@943: ) adamc@937: [_] 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@944: errors <- Monad.foldR3 [fst3] [colMeta M.row] [snd3] [fn _ => option string] adamc@944: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] adamc@937: [[nm] ~ rest] data meta v errors => adamc@937: b <- current ((meta.Handlers data).Validate v); adamc@937: return (if b then adamc@937: errors adamc@937: else adamc@937: case errors of adamc@937: None => Some ((meta.Handlers data).Header) adamc@937: | Some s => Some ((meta.Handlers data).Header adamc@937: ^ ", " ^ s))) adamc@937: 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@944: row' <- Monad.foldR3 [fst3] [colMeta M.row] [snd3] [fn _ => M.row] adamc@944: (fn [nm :: Name] [t :: (Type * Type * Type)] adamc@944: [rest :: {(Type * Type * Type)}] adamc@937: [[nm] ~ rest] data meta v row' => adamc@937: (meta.Handlers data).Update row' v) adamc@937: 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 adamc@937: adamc@937: adamc@940: adamc@940: adamc@937: adamc@937: adamc@937: adamc@937: adamc@937: ) adamc@937: [_] M.folder grid.Cols M.cols cols)}/> adamc@937: adamc@951: end) adamc@951: {Filter = fn all => adamc@951: row <- signal all.Row; adamc@951: foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool] adamc@951: (fn [nm :: Name] [p :: (Type * Type * Type)] adamc@951: [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@951: meta state filter combinedFilter row => adamc@951: previous <- combinedFilter row; adamc@951: this <- (meta.Handlers state).Filter filter row; adamc@951: return (previous && this)) adamc@951: (fn _ => return True) adamc@952: [_] M.folder M.cols grid.Cols grid.Filters row, adamc@953: Sort = return (Some (fn _ _ => return False))} adamc@951: grid.Rows} adamc@915: adamc@937: Monad.mapR2 [aggregateMeta M.row] [id] [id] adamc@937: (fn [nm :: Name] [t :: Type] meta acc => adamc@937: Monad.mp (fn v => meta.Step v acc) adamc@937: (signal row.Row)) adamc@937: [_] M.aggFolder M.aggregates) adamc@937: (mp [aggregateMeta M.row] [id] adamc@937: (fn [t] meta => meta.Initial) adamc@937: [_] M.aggFolder M.aggregates) grid.Rows; adamc@937: return adamc@941: adamc@937: {foldRX2 [aggregateMeta M.row] [id] [_] adamc@937: (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc => adamc@937: ) adamc@937: [_] M.aggFolder M.aggregates rows} adamc@937: }/> adamc@944: adamc@944: adamc@944: {foldRX3 [colMeta M.row] [fst3] [thd3] [_] adamc@944: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@944: meta state filter => ) adamc@944: [_] M.folder M.cols grid.Cols grid.Filters} adamc@944: adamc@915:
adamc@944: {foldRX2 [fst3] [colMeta M.row] [_] adamc@944: (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest] adamc@937: data (meta : colMeta M.row p) => adamc@937: {[(meta.Handlers data).Header]}
adamc@940: adamc@940: else adamc@941: )}/> adamc@940: adamc@937: adamc@937: adamc@937: adamc@937: else adamc@937: !) adamc@937: else adamc@937: return }/> adamc@937:
Aggregates{meta.Display acc}
Filters{(meta.Handlers state).DisplayFilter filter}
adamc@915: adamc@915: