{-|

Budget planning in the Kingdom of Malodivo.

-}
module Malodivo.Budget
  ( DistrictFunds
  , manyToOne
  , manyToMany
  ) where

import qualified Data.HashMap.Strict as HM

import qualified Malodivo.Types.Bill as B
import qualified Malodivo.Types.District as D

-- | Convenient type.
type DistrictFunds = HM.HashMap D.District Integer

{-|

Trivial case: many districts, one bill, no contraints (wishes,
limits).  We assume that, with no explicit wishes, each district
wants to contribute all its funds.

>>> :set -XOverloadedStrings
>>> 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 medium = B.Bill { B.amount = 30, B.name = "A medium bill", B.ministry = M.Science }
>>> let one = B.Bill { B.amount = 1, B.name = "A trivial bill", B.ministry = M.Welfare }


If any district can pay the bill, take funds in proportion.  We use
'HM.lookup', because 'show' of 'HM.HashMap' is not determinate,
and the test can occasionally fail:

>>> let funds = HM.fromList [(D.Palolene, 100), (D.Lakos, 200)]
>>> let contribution = manyToOne funds medium
>>> HM.lookup D.Palolene contribution
Just 10
>>> HM.lookup D.Lakos contribution
Just 20

>>> let funds = HM.fromList [(D.Palolene, 30), (D.Lakos, 30)]
>>> HM.elems $ manyToOne funds medium
[15,15]


It works with a single district:

>>> let funds = HM.fromList [(D.SouthernPalolene, 500)]
>>> HM.elems $ manyToOne funds medium
[30]
>>> HM.elems $ manyToOne funds one
[1]


__TODO__ It /should/ not have rounding issues. In particular,
when the bill's amount is bigger than the number of districts,
/each/ district would contribute some. This problem is known as
<https://en.wikipedia.org/wiki/Partition_(number_theory) integer partition>.

>>> let funds = HM.fromList [(D.Palolene, 10000), (D.Lakos, 1)]
>>> B.amount medium > fromIntegral (HM.size funds)
True
>>> let contribution = manyToOne funds medium
>>> let taken = HM.foldl' (+) 0 contribution


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.
/Thus these two tests show 'False', while should show 'True':/

>>> HM.null $ HM.filter (== 0) contribution
False
>>> taken == B.amount medium
False


If all districts together can't pay the bill, take all their money.
Note that due to the principle of proportionality it is impossible
that some districts can pay their shares and others can't:

>>> let low = HM.fromList [(D.Palolene, 10), (D.Lakos, 15)]
>>> manyToOne low medium == low
True

-}
manyToOne ::
     DistrictFunds -- ^ Amounts of available funds per district.
  -> B.Bill -- ^ A bill requiring funding.
  -> DistrictFunds -- ^ Contribution of each district.
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
    available = sum $ HM.elems funds
    request = min needed available
    takeMoney m = request * m `div` available