Commit | Line | Data |
---|---|---|
208e2cbc AC |
1 | structure Balance :> BALANCE = |
2 | struct | |
3 | ||
4 | open Util Sql Init | |
5 | ||
6 | ||
7 | (* Managing balances *) | |
8 | ||
9 | type balance = {id :int, name : string, amount : real} | |
10 | ||
11 | fun mkBalanceRow [id, name, amount] = | |
12 | {id = C.intFromSql id, name = C.stringFromSql name, amount = C.realFromSql amount} | |
ee587f7f | 13 | | mkBalanceRow row = Init.rowError ("balance", row) |
208e2cbc AC |
14 | |
15 | fun addBalance name = | |
16 | let | |
17 | val db = getDb () | |
18 | val id = nextSeq (db, "BalanceSeq") | |
19 | in | |
20 | C.dml db ($`INSERT INTO Balance (id, name, amount) | |
ee587f7f AC |
21 | VALUES (^(C.intToSql id), ^(C.stringToSql name), 0.0)`); |
22 | id | |
208e2cbc AC |
23 | end |
24 | ||
25 | fun lookupBalance id = | |
26 | let | |
27 | val c = getDb () | |
28 | in | |
29 | (case C.oneOrNoRows c ($`SELECT id, name, amount FROM Balance WHERE id = ^(C.intToSql id)`) of | |
30 | NONE => raise Fail "Balance not found" | |
31 | | SOME r => mkBalanceRow r) | |
32 | end | |
33 | ||
34 | fun modBalance (balance : balance) = | |
35 | let | |
36 | val db = getDb () | |
37 | in | |
38 | ignore (C.dml db ($`UPDATE Balance | |
39 | SET name = ^(C.stringToSql (#name balance)) | |
40 | WHERE id = ^(C.intToSql (#id balance))`)) | |
41 | end | |
42 | ||
43 | fun deleteBalance id = | |
44 | ignore (C.dml (getDb ()) ($`DELETE FROM Balance WHERE id = ^(C.intToSql id)`)) | |
45 | ||
46 | fun listBalances () = | |
47 | C.map (getDb ()) mkBalanceRow ($`SELECT id, name, amount FROM Balance | |
afc975d0 AC |
48 | ORDER BY name`) |
49 | ||
50 | fun listOwnedBalances () = | |
51 | C.map (getDb ()) mkBalanceRow ($`SELECT Balance.id, Balance.name, amount | |
52 | FROM Balance JOIN WebUser | |
53 | ON Balance.name = WebUser.name | |
54 | AND WebUser.bal = Balance.id | |
55 | ORDER BY Balance.name`) | |
208e2cbc | 56 | |
8ffa2c9e AC |
57 | fun listUnownedBalances () = |
58 | C.map (getDb ()) mkBalanceRow ($`SELECT Balance.id, Balance.name, amount | |
59 | FROM Balance LEFT OUTER JOIN WebUser | |
60 | ON Balance.name = WebUser.name | |
61 | AND WebUser.bal = Balance.id | |
62 | WHERE WebUser.id IS NULL | |
63 | ORDER BY Balance.name`) | |
64 | ||
208e2cbc AC |
65 | fun validBalanceName name = |
66 | size name <= 20 | |
67 | andalso CharVector.all (fn ch => Char.isAlpha ch orelse ch = #"+") name | |
68 | ||
69 | fun balanceNameToId name = | |
70 | case C.oneOrNoRows (getDb ()) ($`SELECT id FROM Balance WHERE name = ^(C.stringToSql name)`) of | |
71 | SOME [id] => SOME (C.intFromSql id) | |
72 | | _ => NONE | |
73 | ||
74 | fun listBalanceUsers bal = | |
827fa7c4 | 75 | C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares |
208e2cbc AC |
76 | FROM WebUser |
77 | WHERE bal = ^(C.intToSql bal) | |
78 | ORDER BY name`) | |
79 | ||
8ffa2c9e AC |
80 | fun sumOwnedBalances () = |
81 | case C.oneRow (getDb ()) ($`SELECT SUM(amount) | |
82 | FROM Balance JOIN WebUser | |
83 | ON Balance.name = WebUser.name | |
84 | AND WebUser.bal = Balance.id`) of | |
85 | [amt] => C.realFromSql amt | |
86 | | _ => raise Fail "sumOwnedBalance: no rows" | |
87 | ||
afc975d0 | 88 | end |