From ebe8cba9837872de3dd611d6cd615425c51fefec Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Sat, 24 Jun 2017 13:36:19 +0300
Subject: Support many bills

---
 lib/Malodivo/Budget.hs         | 56 +++++++++++++++++++++++++++++++++++++-----
 lib/Malodivo/Types/District.hs |  4 +--
 2 files changed, 51 insertions(+), 9 deletions(-)

(limited to 'lib')

diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs
index edc0668..e5a7282 100644
--- a/lib/Malodivo/Budget.hs
+++ b/lib/Malodivo/Budget.hs
@@ -6,6 +6,7 @@ Budget planning in the Kingdom of Malodivo.
 module Malodivo.Budget
   ( DistrictFunds
   , manyToOne
+  , manyToMany
   ) where
 
 import qualified Data.HashMap.Strict as HM
@@ -70,8 +71,8 @@ True
 
 
 But at the moment we make use of some freedom coming from the fact
-that \"it is possible that a bill will receive less funds than the
-Parliament decides\", and round down contribution of each district.
+that it is possible that a bill will receive less funds than the
+Parliament decides, and round down contribution of each district.
 /Thus these two tests show 'False', while should show 'True':/
 
 >>> HM.null $ HM.filter (== 0) contribution
@@ -93,9 +94,52 @@ manyToOne ::
      DistrictFunds -- ^ Amounts of available funds per district.
   -> B.Bill -- ^ A bill requiring funding.
   -> DistrictFunds -- ^ Contribution of each district.
-manyToOne funds bill = HM.map takeMoney funds
+manyToOne funds bill = fundRaising funds (B.amount bill)
+
+{-|
+Districts funding multiple bills. No contraints.
+
+>>> :set -XOverloadedStrings
+>>> import Data.Maybe (fromJust)
+>>> import qualified Data.HashMap.Strict as HM
+>>> import qualified Malodivo.Types.Bill as B
+>>> import qualified Malodivo.Types.District as D
+>>> import qualified Malodivo.Types.Ministry as M
+
+>>> let billA = B.Bill { B.amount = 30, B.name = "Bill A", B.ministry = M.Science }
+>>> let billB = B.Bill { B.amount = 10, B.name = "Bill B", B.ministry = M.Welfare }
+>>> let equalAmountBills = take 3 (repeat billB)
+>>> let nonEqualAmountBills = [billA, billB]
+
+
+If all bills requires the same amount, funds of a single district are
+allocated evenly:
+
+>>> let funds = HM.fromList [(D.Palolene, 100)]
+>>> let contribution = manyToMany funds equalAmountBills
+>>> all (== B.amount (head equalAmountBills)) (fromJust . HM.lookup D.Palolene <$> contribution)
+True
+
+-}
+manyToMany ::
+     DistrictFunds -- ^ Amounts of available funds per district.
+  -> [B.Bill] -- ^ Bills requiring funding.
+  -> [DistrictFunds] -- ^ Contribution of each district to each bill.
+manyToMany funds bills = fundRaising funds <$> amountsAllocated
+  where
+    fundsTotal = sum $ HM.elems funds
+    billsTotal = sum $ B.amount <$> bills
+    requestTotal = min billsTotal fundsTotal
+    allocale bill = requestTotal * B.amount bill `div` billsTotal
+    amountsAllocated = allocale <$> bills
+
+-- | Helper function to maintain DRY and backward compatibility.
+fundRaising ::
+     DistrictFunds -- ^ Amounts of available funds per district.
+  -> Integer -- ^ Amount to be raised.
+  -> DistrictFunds -- ^ Contribution of each district.
+fundRaising funds needed = HM.map takeMoney funds
   where
-    needed = B.amount bill
     available = sum $ HM.elems funds
-    requested = min needed available
-    takeMoney m = requested * m `div` available
+    request = min needed available
+    takeMoney m = request * m `div` available
diff --git a/lib/Malodivo/Types/District.hs b/lib/Malodivo/Types/District.hs
index a46628d..058377b 100644
--- a/lib/Malodivo/Types/District.hs
+++ b/lib/Malodivo/Types/District.hs
@@ -22,7 +22,7 @@ module Malodivo.Types.District
 
 import GHC.Generics (Generic)
 
-import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Hashable (Hashable)
 
 -- | District of the Kindom of Malodivo.
@@ -35,7 +35,5 @@ data District
            , Show
            , Generic
            , FromJSON
-           , FromJSONKey
            , ToJSON
-           , ToJSONKey
            )
-- 
cgit v1.2.3