balance.sml

   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`) of
 103         [amt] => C.realFromSql amt
 104       | _ => raise Fail "sumOwnedBalance: no rows"
 105
 106 fun isNegative (bal : balance) = #amount bal < 0.0
 107
 108 end