| 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} |
| 13 | | mkBalanceRow row = Init.rowError ("balance", row) |
| 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) |
| 21 | VALUES (^(C.intToSql id), ^(C.stringToSql name), 0.0)`); |
| 22 | id |
| 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 |
| 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 | JOIN Membership |
| 56 | ON Membership.grp = 1 |
| 57 | AND Membership.usr = WebUser.id |
| 58 | ORDER BY Balance.name`) |
| 59 | |
| 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 |
| 66 | ON Membership.grp = 1 |
| 67 | AND Membership.usr = WebUser.id |
| 68 | WHERE WebUser.id IS NULL |
| 69 | OR Membership.grp IS NULL |
| 70 | ORDER BY Balance.name`) |
| 71 | |
| 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 | |
| 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 = |
| 93 | C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout |
| 94 | FROM WebUser |
| 95 | WHERE bal = ^(C.intToSql bal) |
| 96 | ORDER BY name`) |
| 97 | |
| 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 |
| 103 | JOIN Membership |
| 104 | ON Membership.usr = WebUser.id |
| 105 | AND Membership.grp = 1`) of |
| 106 | [amt] => C.realFromSql amt |
| 107 | | _ => raise Fail "sumOwnedBalance: no rows" |
| 108 | |
| 109 | fun isNegative (bal : balance) = #amount bal < 0.0 |
| 110 | |
| 111 | fun depositAmount _ = 7.0 * 3.0 |
| 112 | (*fun depositAmount bal = |
| 113 | let |
| 114 | val db = getDb () |
| 115 | |
| 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) |
| 119 | in |
| 120 | 3.0 * 900.0 / real totalShares |
| 121 | end*) |
| 122 | |
| 123 | end |