remind/remind.sml

   1 structure Remind :> REMIND =
   2 struct
   3
   4 open Config
   5
   6 structure C = PgClient
   7
   8 fun printReal n =
   9     if n < 0.0 then
  10         "-" ^ Real.fmt (StringCvt.FIX (SOME 2)) (~n)
  11     else
  12         Real.fmt (StringCvt.FIX (SOME 2)) n
  13
  14 fun main _ =
  15     let
  16         val db = C.conn dbstring
  17
  18         val totalShares = case C.oneRow db "SELECT SUM(shares) FROM WebUserPaying" of
  19                               [total] => C.intFromSql total
  20                             | _ => raise Fail "Bad SUM(shares) row"
  21
  22         fun doOne [user, members, shares, amount] =
  23             let
  24                 val user = C.stringFromSql user
  25                 val members = C.intFromSql members
  26                 val shares = C.intFromSql shares
  27                 val amount = C.realFromSql amount
  28
  29                 val minimum = 900.0 * real shares / real totalShares * 2.0
  30             in
  31                 if amount >= minimum then
  32                     ()
  33                 else
  34                     let
  35                         val m = Mail.mopen ()
  36                         fun write msg = Mail.mwrite (m, msg)
  37                     in
  38                         if amount < 0.0 then
  39                             write "Subject: Your NEGATIVE HCoop balance\n"
  40                         else
  41                             write "Subject: Your low HCoop balance\n";
  42                         write "From: HCoop Payment Reminder Robot <payment";
  43                         write emailSuffix;
  44                         write ">\n";
  45                         write "To: ";
  46                         write user;
  47                         write emailSuffix;
  48                         write "\nCc: payment@hcoop.net";
  49                         write "\n\n";
  50
  51                         if amount < 0.0 then
  52                             (write "Your HCoop balance is negative.  This means that you've paid less than you've\n";
  53                              write "been charged to date.  Our bylaws allow our board of directors to vote you out\n";
  54                              write "of the co-op, without any obligation to contact you first, when your balance\n";
  55                              write "stays negative for three months.  Please make a payment as soon as possible, so\n";
  56                              write "that we don't need to do this!\n\n")
  57                         else
  58                             (write "Your HCoop balance has dropped below your requested minimum, based on your\n";
  59                              write "sliding scale pledge amount.  Please make a payment as soon as you can.\n\n");
  60
  61                         write "Your balance: US$";
  62                         write (printReal amount);
  63                         write "\nTotal number of members linked to your balance: ";
  64                         write (Int.toString members);
  65                         write "\nTotal pledge amount: ";
  66                         write (Int.toString shares);
  67                         write "\nRequested minimum: US$";
  68                         write (printReal (900.0 * real shares / real totalShares * 2.0));
  69
  70                         write "\n\nYour minimum was calculated by dividing our total monthly expenses ($900) by the\n";
  71                         write "sum of all members' pledge amounts, multiplying by your pledge amount, and then\n";
  72                         write "multiplying by 2.  That is, the amount covers your share of two months' expenses.\n\n";
  73
  74                         write "To make a payment, visit:\n";
  75                         write "     https://members2.hcoop.net/\n";
  76                         write "and use the PayPal or Google Checkout link.\n";
  77
  78                         write "\nIf you don't know how to get a username and password for members2.hcoop.net, visit:\n";
  79                         write "     http://wiki2.hcoop.net/MemberManual/MigrationGuide\n";
  80                         write "for a reminder.  (\"Step 1\" is all you need to read.)\n";
  81
  82                         write "\nIf for whatever reason you don't plan to pay the amount suggested in this e-mail,\n";
  83                         write "_please_ don't stay silent.  Reply to this message explaining your circumstances.\n";
  84                         write "We are doing limited-time monetary grants on request, due to the extra costs\n";
  85                         write "associated with setting up our new servers.\n";
  86
  87                         ignore (Mail.mclose m)
  88                     end
  89             end
  90           | doOne _ = raise Fail "Bad SQL row"
  91     in
  92         C.app db doOne "SELECT Balance.name, COUNT(*), SUM(WebUserPaying.shares) AS shrs, Balance.amount FROM WebUserPaying JOIN Balance ON WebUserPaying.bal = Balance.id GROUP BY Balance.name, Balance.amount HAVING amount < 10";
  93         C.close db;
  94         OS.Process.success
  95     end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n");
  96                            OS.Process.failure)
  97
  98 end