adamc@1002: con colMeta = fn (db :: Type, state :: Type) => adamc@650: {Nam : string, adamc@1002: Show : db -> xbody, adamc@1002: Inject : sql_injectable db, adamc@650: adamc@1002: NewState : transaction state, adamc@1002: Widget : state -> xbody, adamc@1002: ReadState : state -> transaction db} adam@1302: con colsMeta = fn cols => $(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: 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@1093: (@foldR2 [fst] [colMeta] adam@1302: [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)] adam@1302: (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] input col acc => adamc@1093: acc ++ {nm = @sql_inject col.Inject input}) adamc@1093: {} M.fl (r -- #Id) M.cols adamc@1093: ++ {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@1172: {@mapX2 [colMeta] [fst] [_] adam@1302: (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m v => adamc@1093: {m.Show v}) adamc@1093: M.fl M.cols (r -- #Id)} adamc@650: {if withDel then adamc@908: