1 structure Balance
:> BALANCE
=
7 (* Managing balances
*)
9 type balance
= {id
:int, name
: string, amount
: real}
11 fun mkBalanceRow
[id
, name
, amount
] =
12 {id
= C
.intFromSql id
, name
= C
.stringFromSql name
, amount
= C
.realFromSql amount
}
13 | mkBalanceRow row
= Init
.rowError ("balance", row
)
18 val id
= nextSeq (db
, "BalanceSeq")
20 C
.dml
db ($`INSERT INTO
Balance (id
, name
, amount
)
21 VALUES (^
(C
.intToSql id
), ^
(C
.stringToSql name
), 0.0)`
);
25 fun lookupBalance id
=
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
)
34 fun modBalance (balance
: balance
) =
38 ignore (C
.dml
db ($`UPDATE Balance
39 SET name
= ^
(C
.stringToSql (#name balance
))
40 WHERE id
= ^
(C
.intToSql (#id balance
))`
))
43 fun deleteBalance id
=
44 ignore (C
.dml (getDb ()) ($`DELETE FROM Balance WHERE id
= ^
(C
.intToSql id
)`
))
47 C
.map (getDb ()) mkBalanceRow ($`SELECT id
, name
, amount FROM Balance
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
57 AND Membership
.usr
= WebUser
.id
58 ORDER BY Balance
.name`
)
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
65 LEFT OUTER JOIN Membership
67 AND Membership
.usr
= WebUser
.id
68 WHERE WebUser
.id IS NULL
69 OR Membership
.grp IS NULL
70 ORDER BY Balance
.name`
)
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
79 AND Membership
.usr
= WebUser
.id
81 ORDER BY Balance
.name`
)
83 fun validBalanceName name
=
85 andalso CharVector
.all (fn ch
=> Char.isAlpha ch
orelse ch
= #
"+") name
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
)
92 fun listBalanceUsers bal
=
93 C
.map (getDb ()) mkUserRow ($`SELECT id
, name
, rname
, bal
, joined
, app
, shares
, paypal
, checkout
95 WHERE bal
= ^
(C
.intToSql bal
)
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
104 ON Membership
.usr
= WebUser
.id
105 AND Membership
.grp
= 1`
) of
106 [amt
] => C
.realFromSql amt
107 | _
=> raise Fail
"sumOwnedBalance: no rows"
109 fun isNegative (bal
: balance
) = #amount bal
< 0.0
111 fun depositAmount _
= 7.0 * 3.0
112 (*fun depositAmount bal
=
116 val totalShares
= case C
.oneRow db
"SELECT SUM(shares) FROM WebUserPaying" of
117 [n
] => C
.intFromSql n
118 | row
=> Init
.rowError ("Bad depositAmount share count result", row
)
120 3.0 * 900.0 / real totalShares