Mercurial > urweb
comparison demo/more/orm.ur @ 1002:bb3fc575cfe7
Adapted existing demos to tuple pattern-matching
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 20 Oct 2009 10:29:17 -0400 |
parents | b132f8620a66 |
children | 8d3aa6c7cee0 |
comparison
equal
deleted
inserted
replaced
1001:1d456a06ea4e | 1002:bb3fc575cfe7 |
---|---|
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) = return None |
3 | 3 |
4 con meta = fn col_parent :: (Type * Type) => { | 4 con meta = fn (col :: Type, parent :: Type) => { |
5 Link : link col_parent, | 5 Link : link (col, parent), |
6 Inj : sql_injectable col_parent.1 | 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) = {Link = noParent, |
10 Inj = inj} | 10 Inj = inj} |
11 | 11 |
53 val list = resultsOut (SELECT * FROM t) | 53 val list = resultsOut (SELECT * FROM t) |
54 | 54 |
55 con col = fn t => {Exp : sql_exp [T = fs] [] [] t, | 55 con col = fn t => {Exp : sql_exp [T = fs] [] [] t, |
56 Inj : sql_injectable t} | 56 Inj : sql_injectable t} |
57 val idCol = {Exp = sql_field [#T] [#Id], Inj = _} | 57 val idCol = {Exp = sql_field [#T] [#Id], Inj = _} |
58 con meta' = fn (fs :: {Type}) (col_parent :: (Type * Type)) => | 58 con meta' = fn (fs :: {Type}) (col :: Type, parent :: Type) => |
59 {Col : {Exp : sql_exp [T = fs] [] [] col_parent.1, | 59 {Col : {Exp : sql_exp [T = fs] [] [] col, |
60 Inj : sql_injectable col_parent.1}, | 60 Inj : sql_injectable col}, |
61 Parent : $fs -> transaction (option col_parent.2)} | 61 Parent : $fs -> transaction (option parent)} |
62 val cols = foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] => | 62 val cols = foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] => |
63 $(map (meta' (map fst (before ++ after))) before)] | 63 $(map (meta' (map fst (before ++ after))) before)] |
64 (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}] | 64 (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}] |
65 [[nm] ~ before] (meta : meta ts) | 65 [[nm] ~ before] (meta : meta ts) |
66 (acc : after :: {(Type * Type)} -> [before ~ after] => | 66 (acc : after :: {(Type * Type)} -> [before ~ after] => |