adamc@987: con link = fn t :: Type => unit
adamc@987: 
adamc@987: con meta = fn col :: Type => {
adamc@987:               Link : link col,
adamc@987:               Inj : sql_injectable col
adamc@987:               }
adamc@987: 
adamc@987: functor Table(M : sig
adamc@987:                   con cols :: {Type}
adamc@987:                   val cols : $(map meta cols)
adamc@987:                   constraint [Id] ~ cols
adamc@987:                   val folder : folder cols
adamc@987:               end) = struct
adamc@987:     type id = int
adamc@987:     val inj = _
adamc@987:     val id : meta id = {Link = (),
adamc@987:                         Inj = inj}
adamc@987: 
adamc@989:     con fs = [Id = id] ++ M.cols
adamc@989: 
adamc@987:     sequence s
adamc@989:     table t : fs
adamc@987: 
adamc@989:     type row = $fs
adamc@988: 
adamc@988:     fun ensql [avail] (r : $M.cols) : $(map (sql_exp avail [] []) M.cols) =
adamc@988:         map2 [meta] [Top.id] [sql_exp avail [] []]
adamc@988:              (fn [t] meta v => @sql_inject meta.Inj v)
adamc@988:              [_] M.folder M.cols r
adamc@988: 
adamc@987:     fun create (r : $M.cols) =
adamc@987:         id <- nextval s;
adamc@988:         dml (insert t ({Id = sql_inject id} ++ ensql r));
adamc@988:         return ({Id = id} ++ r)
adamc@988: 
adamc@988:     fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]})
adamc@988: 
adamc@988:     fun save r = dml (update [M.cols] ! (ensql (r -- #Id)) t (WHERE T.Id = {[r.Id]}))
adamc@988: 
adamc@988:     fun lookup id =
adamc@988:         ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]});
adamc@988:         return (Option.mp (fn r => r.T) ro)
adamc@988: 
adamc@989:     fun resultsOut q = query q (fn r ls => return (r.T :: ls)) []
adamc@989: 
adamc@989:     val list = resultsOut (SELECT * FROM t)
adamc@989: 
adamc@989:     con col = fn t => {Exp : sql_exp [T = fs] [] [] t,
adamc@989:                        Inj : sql_injectable t}
adamc@989:     val idCol = {Exp = sql_field [#T] [#Id], Inj = _}
adamc@989:     val cols = foldR [meta] [fn before => after :: {Type} -> [before ~ after] =>
adamc@989:                                 $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
adamc@989:                                                 Inj : sql_injectable t}) before)]
adamc@989:                (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before] (meta : meta t)
adamc@989:                                 (acc : after :: {Type} -> [before ~ after] =>
adamc@989:                                  $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
adamc@989:                                                  Inj : sql_injectable t}) before))
adamc@989:                                 [after :: {Type}] [[nm = t] ++ before ~ after] =>
adamc@989:                    {nm = {Exp = sql_field [#T] [nm],
adamc@989:                           Inj = meta.Inj}} ++ acc [[nm = t] ++ after] !)
adamc@989:                (fn [after :: {Type}] [[] ~ after] => {})
adamc@989:                [_] M.folder M.cols
adamc@989:                [[Id = id]] !
adamc@989: 
adamc@989:     type filter = sql_exp [T = fs] [] [] bool
adamc@989:     fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f})
adamc@989: 
adamc@989:     fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) =
adamc@989:         sql_binary b c.Exp (@sql_inject c.Inj v)
adamc@989:     val eq = bin @@sql_eq
adamc@989:     val ne = bin @@sql_ne
adamc@989:     val lt = bin @@sql_lt
adamc@989:     val le = bin @@sql_le
adamc@989:     val gt = bin @@sql_gt
adamc@989:     val ge = bin @@sql_ge
adamc@989: 
adamc@989:     fun bb (b : sql_binary bool bool bool) (f1 : filter) (f2 : filter) =
adamc@989:         sql_binary b f1 f2
adamc@989:     val _and = bb sql_and
adamc@989:     val or = bb sql_or
adamc@987: end