1 structure Contact
:> CONTACT
=
7 (* Managing transactions
*)
9 type kind
= {id
:int, name
: string, makeUrl
: (string * string) option
}
11 fun makerToSql NONE
= "FALSE, NULL, NULL"
12 |
makerToSql (SOME (pre
, post
)) = $`TRUE
, ^
(C
.stringToSql pre
), ^
(C
.stringToSql post
)`
14 fun makerToSqlUpd NONE
= "url = FALSE, urlPrefix = NULL, urlPostfix = NULL"
15 |
makerToSqlUpd (SOME (pre
, post
)) = $`url
= TRUE
, urlPrefix
= ^
(C
.stringToSql pre
), urlPostfix
= ^
(C
.stringToSql post
)`
17 fun mkKindRow
[id
, name
, url
, urlPrefix
, urlPostfix
] =
18 {id
= C
.intFromSql id
, name
= C
.stringFromSql name
,
19 makeUrl
= (if C
.boolFromSql url
then
20 SOME (C
.stringFromSql urlPrefix
, C
.stringFromSql urlPostfix
)
23 | mkKindRow row
= raise Fail ("Bad kind row : " ^ makeSet id row
)
25 fun addKind (name
, makeUrl
) =
28 val id
= nextSeq (db
, "ContactKindSeq")
30 C
.dml
db ($`INSERT INTO
ContactKind (id
, name
, url
, urlPrefix
, urlPostfix
)
31 VALUES (^id
, ^
(C
.stringToSql name
), ^
(makerToSql makeUrl
))`
);
39 (case C
.oneOrNoRows
c ($`SELECT id
, name
, url
, urlPrefix
, urlPostfix FROM ContactKind WHERE id
= ^
(C
.intToSql id
)`
) of
40 NONE
=> raise Fail
"Contact kind not found"
41 | SOME r
=> mkKindRow r
)
44 fun modKind (kind
: kind
) =
48 ignore (C
.dml
db ($`UPDATE ContactKind
49 SET name
= ^
(C
.stringToSql (#name kind
)), ^
(makerToSqlUpd (#makeUrl kind
))
50 WHERE id
= ^
(C
.intToSql (#id kind
))`
))
54 ignore (C
.dml (getDb ()) ($`DELETE FROM ContactKind WHERE id
= ^
(C
.intToSql id
)`
))
57 C
.map (getDb ()) mkKindRow ($`SELECT id
, name
, url
, urlPrefix
, urlPostfix FROM ContactKind