Mercurial > urweb

comparison demo/more/orm.ur @ 1304:f0afe61a6f8b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tweaking unification fix to apply to demo/more
author Adam Chlipala <adam@chlipala.net>
date Sun, 10 Oct 2010 15:37:14 -0400
parents 8d3aa6c7cee0
children e2611b5dafce
comparison
equal deleted inserted replaced
1303:c7b9a33c26c8 1304:f0afe61a6f8b
1 con link = fn col_parent :: (Type * Type) => col_parent.1 -> transaction (option col_parent.2) 1 con link = fn col_parent :: (Type * Type) => col_parent.1 -> transaction (option col_parent.2)
2 fun noParent [t ::: Type] (_ : t) = return None 2 fun noParent [t ::: Type] (_ : t) : transaction (option unit) = return None
3 3
4 con meta = fn (col :: Type, parent :: Type) => { 4 con meta = fn (col :: Type, parent :: Type) => {
5 Link : link (col, parent), 5 Link : link (col, parent),
6 Inj : sql_injectable col 6 Inj : sql_injectable col
7 } 7 }
8 8
9 fun local [t :: Type] (inj : sql_injectable t) = {Link = noParent, 9 fun local [t :: Type] (inj : sql_injectable t) : meta (t, unit) =
10 Inj = inj} 10 {Link = noParent,
11 Inj = inj}
11 12
12 functor Table(M : sig 13 functor Table(M : sig
13 con cols :: {(Type * Type)} 14 con cols :: {(Type * Type)}
14 val cols : $(map meta cols) 15 val cols : $(map meta cols)
15 constraint [Id] ~ cols 16 constraint [Id] ~ cols
29 30
30 val inj = _ 31 val inj = _
31 val id = {Link = fn id => resultOut (SELECT * FROM t WHERE t.Id = {[id]}), 32 val id = {Link = fn id => resultOut (SELECT * FROM t WHERE t.Id = {[id]}),
32 Inj = inj} 33 Inj = inj}
33 34
34 fun ensql [avail] (r : row') : $(map (sql_exp avail [] []) fs') = 35 fun ensql [avail ::_] (r : row') : $(map (sql_exp avail [] []) fs') =
35 @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1] 36 @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
36 (fn [ts] meta v => @sql_inject meta.Inj v) 37 (fn [ts] meta v => @sql_inject meta.Inj v)
37 M.folder M.cols r 38 M.folder M.cols r
38 39
39 fun create (r : row') = 40 fun create (r : row') =
40 id <- nextval s; 41 id <- nextval s;
41 dml (insert t ({Id = sql_inject id} ++ ensql r)); 42 dml (insert t ({Id = sql_inject id} ++ ensql [[]] r));
42 return ({Id = id} ++ r) 43 return ({Id = id} ++ r)
43 44
44 fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]}) 45 fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]})
45 46
46 fun save r = dml (update [fs'] (ensql (r -- #Id)) t (WHERE T.Id = {[r.Id]})) 47 fun save r = dml (update [fs'] (ensql [[T = [Id = int] ++ map fst M.cols]] (r -- #Id)) t (WHERE T.Id = {[r.Id]}))
47 48
48 fun lookup id = 49 fun lookup id =
49 ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]}); 50 ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]});
50 return (Option.mp (fn r => r.T) ro) 51 return (Option.mp (fn r => r.T) ro)
51 52