adamc@993: functor Make(M : sig
adamc@993:                  con key :: {Type}
adamc@993:                  con data :: {Type}
adamc@993:                  constraint key ~ data
adamc@993:                  constraint [When] ~ (key ++ data)
adamc@993: 
adamc@993:                  val key : $(map sql_injectable key)
adamc@993:                  val data : $(map (fn t => {Inj : sql_injectable_prim t,
adamc@993:                                             Eq : eq t}) data)
adamc@993: 
adamc@993:                  val keyFolder : folder key
adamc@993:                  val dataFolder : folder data
adamc@993:              end) = struct
adamc@993:     con all = [When = time] ++ M.key ++ map option M.data
adamc@993:     table t : all
adamc@993: 
adamc@993:     val keys = List.mapQuery (SELECT DISTINCT t.{{M.key}} FROM t) (fn r => r.T)
adamc@993: 
adamc@993:     con dmeta = fn t => {Inj : sql_injectable_prim t,
adamc@993:                          Eq : eq t}
adamc@993: 
adamc@993:     fun keyRecd (r : $(M.key ++ M.data)) =
adamc@993:         map2 [sql_injectable] [id] [sql_exp [] [] []]
adamc@993:              (fn [t] => @sql_inject)
adamc@993:              [_] M.keyFolder M.key (r --- M.data)
adamc@993: 
adamc@993:     fun insert r = dml (Basis.insert t
adamc@993:                                      ({When = (SQL CURRENT_TIMESTAMP)}
adamc@993:                                           ++ keyRecd r
adamc@993:                                           ++ map2 [dmeta] [id]
adamc@993:                                           [fn t => sql_exp [] [] [] (option t)]
adamc@993:                                           (fn [t] x v => @sql_inject (@sql_option_prim x.Inj)
adamc@993:                                                           (Some v))
adamc@993:                                           [_] M.dataFolder M.data (r --- M.key)))
adamc@993: 
adamc@993:     fun keyExp (r : $M.key) : sql_exp [T = all] [] [] bool =
adamc@993:         foldR2 [sql_injectable] [id] [fn before => after :: {Type} -> [before ~ after]
adamc@993:                                          => sql_exp [T = before ++ after] [] [] bool]
adamc@993:                (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
adamc@993:                                 (inj : sql_injectable t) (v : t)
adamc@993:                    (e : after :: {Type} -> [before ~ after]
adamc@993:                     => sql_exp [T = before ++ after] [] [] bool)
adamc@993:                    [after :: {Type}] [[nm = t] ++ before ~ after] =>
adamc@993:                    (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after] !}))
adamc@993:                (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
adamc@993:                [_] M.keyFolder M.key r
adamc@993:                [_] !
adamc@993: 
adamc@993:     fun current k =
adamc@993:         let
adamc@993:             fun current' timeOpt r =
adamc@993:                 let
adamc@993:                     val complete = foldR [option] [fn ts => option $ts]
adamc@993:                                    (fn [nm :: Name] [v :: Type] [r :: {Type}] [[nm] ~ r]
adamc@993:                                                     v r =>
adamc@993:                                        case (v, r) of
adamc@993:                                            (Some v, Some r) => Some ({nm = v} ++ r)
adamc@993:                                          | _ => None)
adamc@993:                                    (Some {}) [_] M.dataFolder r
adamc@993:                 in
adamc@993:                     case complete of
adamc@993:                         Some r => return (Some r)
adamc@993:                       | None =>
adamc@993:                         let
adamc@993:                             val filter = case timeOpt of
adamc@993:                                              None => (WHERE TRUE)
adamc@993:                                            | Some time => (WHERE t.When < {[time]})
adamc@993:                         in
adamc@993:                             ro <- oneOrNoRows (SELECT t.When, t.{{map option M.data}}
adamc@993:                                                FROM t
adamc@993:                                                WHERE {filter}
adamc@993:                                                  AND {keyExp k}
adamc@993:                                                ORDER BY t.When DESC
adamc@993:                                                LIMIT 1);
adamc@993:                             case ro of
adamc@993:                                 None => return None
adamc@993:                               | Some r' =>
adamc@993:                                 let
adamc@993:                                     val r = map2 [option] [option] [option]
adamc@993:                                             (fn [t ::: Type] old new =>
adamc@993:                                                 case old of
adamc@993:                                                     None => new
adamc@993:                                                   | Some _ => old)
adamc@993:                                             [_] M.dataFolder r (r'.T -- #When)
adamc@993:                                 in
adamc@993:                                     current' (Some r'.T.When) r
adamc@993:                                 end
adamc@993:                         end
adamc@993:                 end
adamc@993:         in
adamc@993:             current' None (map0 [option] (fn [t :: Type] => None : option t) [_] M.dataFolder)
adamc@993:         end
adamc@993: 
adamc@993:     fun update r =
adamc@993:         cur <- current (r --- M.data);
adamc@993:         case cur of
adamc@993:             None => error <xml>Tried to update nonexistent key</xml>
adamc@993:           | Some cur =>
adamc@993:             let
adamc@993:                 val r' = map3 [dmeta] [id] [id] [fn t => sql_exp [] [] [] (option t)]
adamc@993:                               (fn [t] (meta : dmeta t) old new =>
adamc@993:                                   @sql_inject (@sql_option_prim meta.Inj)
adamc@993:                                    (if @@eq [_] meta.Eq old new then
adamc@993:                                         None
adamc@993:                                     else
adamc@993:                                         Some new))
adamc@993:                               [_] M.dataFolder M.data cur (r --- M.key)
adamc@993:                 val r' = {When = (SQL CURRENT_TIMESTAMP)}
adamc@993:                              ++ keyRecd r
adamc@993:                              ++ r'
adamc@993:             in
adamc@993:                 dml (Basis.insert t r')
adamc@993:             end
adamc@993: end