adamc@650: con colMeta = fn t_state :: (Type * Type) => adamc@650: {Nam : string, adamc@650: Show : t_state.1 -> xbody, adamc@650: Inject : sql_injectable t_state.1, adamc@650: adamc@650: NewState : transaction t_state.2, adamc@650: Widget : t_state.2 -> xbody, adamc@650: ReadState : t_state.2 -> transaction t_state.1} adamc@650: con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols) adamc@650: adamc@823: fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) adamc@650: name : colMeta (t, source string) = adamc@650: {Nam = name, adamc@650: Show = txt, adamc@650: Inject = _, adamc@650: adamc@650: NewState = source "", adamc@650: Widget = fn s => , adamc@650: ReadState = fn s => v <- get s; return (readError v)} adamc@650: adamc@650: val int = default adamc@650: val float = default adamc@650: val string = default adamc@650: adamc@650: functor Make(M : sig adamc@650: con cols :: {(Type * Type)} adamc@650: constraint [Id] ~ cols adamc@650: val fl : folder cols adamc@650: adamc@706: table tab : ([Id = int] ++ map fst cols) adamc@650: adamc@650: val title : string adamc@650: adamc@650: val cols : colsMeta cols adamc@650: end) = struct adamc@650: adamc@650: open constraints M adamc@650: val t = M.tab adamc@650: adamc@650: datatype list t = Nil | Cons of t * list t adamc@650: adamc@650: fun allRows () = adamc@650: query (SELECT * FROM t) adamc@650: (fn r acc => return (Cons (r.T, acc))) adamc@650: Nil adamc@650: adamc@650: fun add r = adamc@650: dml (insert t adamc@650: (foldR2 [fst] [colMeta] adamc@650: [fn cols => $(map (fn t :: (Type * Type) => adamc@650: sql_exp [] [] [] t.1) cols)] adamc@823: (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] adamc@650: [[nm] ~ rest] input col acc => adamc@650: acc ++ {nm = @sql_inject col.Inject input}) adamc@650: {} [M.cols] M.fl (r -- #Id) M.cols adamc@650: ++ {Id = (SQL {[r.Id]})})) adamc@650: adamc@650: fun doBatch ls = adamc@650: case ls of adamc@650: Nil => return () adamc@650: | Cons (r, ls') => adamc@650: add r; adamc@650: doBatch ls' adamc@650: adamc@650: fun del id = adamc@650: dml (DELETE FROM t WHERE t.Id = {[id]}) adamc@650: adamc@650: fun show withDel lss = adamc@650: let adamc@650: fun show' ls = adamc@650: case ls of adamc@650: Nil => adamc@650: | Cons (r, ls) => adamc@650: adamc@650: {[r.Id]} adamc@650: {foldRX2 [colMeta] [fst] [_] adamc@823: (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] adamc@650: [[nm] ~ rest] m v => adamc@650: {m.Show v}) adamc@650: [M.cols] M.fl M.cols (r -- #Id)} adamc@650: {if withDel then adamc@650: