X-Git-Url: https://git.hcoop.net/bpt/portal.git/blobdiff_plain/d5f8418bc9167e9597c463175b38830ba17624b6..e38fe5b0e18be227d05b0071de8773d4b8c02236:/money.sml

diff --git a/money.sml b/money.sml
index f4423ac..1b569c8 100644
--- a/money.sml
+++ b/money.sml
@@ -273,4 +273,25 @@ fun costBase amt =
 	[share] => C.realFromSql share
       | row => Init.rowError ("Bad costBase result", row)
 
+val monthlyCost = 900.0
+val graceMonths = 1
+
+fun delinquentPledgers () =
+    let
+	val costBase = costBase monthlyCost
+
+	fun makeRow [id, name, shares, amount] = {id = C.intFromSql id, name = C.stringFromSql name,
+						  shares = C.intFromSql shares, balance = C.realFromSql amount}
+	  | makeRow row = Init.rowError ("Bad delinquentPledgers", row)
+    in
+	C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, shares, amount
+				    FROM WebUserPaying JOIN Balance ON Balance.id = bal
+				    WHERE amount < shares * ^(C.realToSql costBase) * ^(C.intToSql graceMonths)
+				      AND shares > 1
+				    ORDER BY name`)
+    end
+
+fun resetPledges ids =
+    raise Fail ($`UPDATE WebUser SET shares = 1 WHERE id IN (^(String.concatWith ", " (List.map C.intToSql ids)))`)
+
 end