8d347a33 |
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} |
369e1577 |
13 | | mkBalanceRow row = Init.rowError ("balance", row) |
8d347a33 |
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) |
369e1577 |
21 | VALUES (^(C.intToSql id), ^(C.stringToSql name), 0.0)`); |
22 | id |
8d347a33 |
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 |
a90420b4 |
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 |
ef48ed9e |
55 | JOIN Membership |
56 | ON Membership.grp = 1 |
57 | AND Membership.usr = WebUser.id |
a90420b4 |
58 | ORDER BY Balance.name`) |
8d347a33 |
59 | |
b49e2370 |
60 | fun listUnownedBalances () = |
61 | C.map (getDb ()) mkBalanceRow ($`SELECT Balance.id, Balance.name, amount |
62 | FROM Balance LEFT OUTER JOIN WebUser |
63 | ON Balance.name = WebUser.name |
64 | AND WebUser.bal = Balance.id |
ef48ed9e |
65 | LEFT OUTER JOIN Membership |
66 | ON Membership.grp = 1 |
67 | AND Membership.usr = WebUser.id |
b49e2370 |
68 | WHERE WebUser.id IS NULL |
ef48ed9e |
69 | OR Membership.grp IS NULL |
b49e2370 |
70 | ORDER BY Balance.name`) |
71 | |
bde01dd3 |
72 | fun listNegativeOwnedBalances () = |
73 | C.map (getDb ()) mkBalanceRow ($`SELECT Balance.id, Balance.name, amount |
74 | FROM Balance JOIN WebUser |
75 | ON Balance.name = WebUser.name |
76 | AND WebUser.bal = Balance.id |
77 | JOIN Membership |
78 | ON Membership.grp = 1 |
79 | AND Membership.usr = WebUser.id |
80 | WHERE amount < 0 |
81 | ORDER BY Balance.name`) |
82 | |
8d347a33 |
83 | fun validBalanceName name = |
84 | size name <= 20 |
85 | andalso CharVector.all (fn ch => Char.isAlpha ch orelse ch = #"+") name |
86 | |
87 | fun balanceNameToId name = |
88 | case C.oneOrNoRows (getDb ()) ($`SELECT id FROM Balance WHERE name = ^(C.stringToSql name)`) of |
89 | SOME [id] => SOME (C.intFromSql id) |
90 | | _ => NONE |
91 | |
92 | fun listBalanceUsers bal = |
302c9f57 |
93 | C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares |
8d347a33 |
94 | FROM WebUser |
95 | WHERE bal = ^(C.intToSql bal) |
96 | ORDER BY name`) |
97 | |
b49e2370 |
98 | fun sumOwnedBalances () = |
99 | case C.oneRow (getDb ()) ($`SELECT SUM(amount) |
100 | FROM Balance JOIN WebUser |
101 | ON Balance.name = WebUser.name |
102 | AND WebUser.bal = Balance.id`) of |
103 | [amt] => C.realFromSql amt |
104 | | _ => raise Fail "sumOwnedBalance: no rows" |
105 | |
a90420b4 |
106 | end |