4 files changed, 218 insertions, 0 deletions
diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs
new file mode 100644
index 0000000..edc0668
--- /dev/null
+++ b/lib/Malodivo/Budget.hs
@@ -0,0 +1,101 @@
+{-|
+
+Budget planning in the Kingdom of Malodivo.
+
+-}
+module Malodivo.Budget
+  ( DistrictFunds
+  , manyToOne
+  ) 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 = HM.map takeMoney funds
+  where
+    needed = B.amount bill
+    available = sum $ HM.elems funds
+    requested = min needed available
+    takeMoney m = requested * m `div` available
diff --git a/lib/Malodivo/Types/Bill.hs b/lib/Malodivo/Types/Bill.hs
new file mode 100644
index 0000000..336c0fb
--- /dev/null
+++ b/lib/Malodivo/Types/Bill.hs
@@ -0,0 +1,44 @@
+{-|
+
+A bill is a proposed law put before the Parliament to consider and
+possibly implement.  Bills can be encoded to and decoded from JSON.
+
+>>> :set -XOverloadedStrings
+>>> import Data.Aeson (decode, encode)
+>>> import Data.Maybe (fromJust)
+>>> import Malodivo.Types.Ministry (Ministry(..))
+
+>>> let billGreateWall = Bill { name = "The Great Wall of Malodivo", ministry = Defense, amount = 4000 }
+>>> encode billGreateWall
+"{\"amount\":4000,\"name\":\"The Great Wall of Malodivo\",\"ministry\":\"Defense\"}"
+
+>>> let billShelters = fromJust $ decode "{\"amount\":1234,\"name\":\"Shelters for the Homeless\",\"ministry\":\"Welfare\"}"
+>>> billShelters :: Bill
+Bill {name = "Shelters for the Homeless", ministry = Welfare, amount = 1234}
+
+>>> ministry <$> [billShelters, billGreateWall]
+[Welfare,Defense]
+
+>>> sum $ amount <$> [billShelters, billGreateWall]
+5234
+
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Malodivo.Types.Bill
+  ( Bill(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Text (Text)
+
+import Malodivo.Types.Ministry (Ministry)
+
+data Bill = Bill
+  { name :: Text -- ^ the name of a bill, e. g. \"An Act to Construct the Great Wall of Malodivo\".
+  , ministry :: Ministry -- ^ the ministry getting funds to implement a bill.
+  , amount :: Integer -- ^ the amount of funds required to implement a bill.
+  } deriving (Show, Generic, FromJSON, ToJSON)
diff --git a/lib/Malodivo/Types/District.hs b/lib/Malodivo/Types/District.hs
new file mode 100644
index 0000000..a46628d
--- /dev/null
+++ b/lib/Malodivo/Types/District.hs
@@ -0,0 +1,41 @@
+{-|
+Districts can be encoded to and decoded from JSON:
+
+>>> import Data.Aeson (decode, encode)
+>>> import Data.ByteString.Lazy.Char8 (pack)
+
+>>> encode Palolene
+"\"Palolene\""
+
+>>> encode [ Lakos, SouthernPalolene ]
+"[\"Lakos\",\"SouthernPalolene\"]"
+
+>>> decode . pack $ "[ \"Lakos\" ]" :: Maybe [District]
+Just [Lakos]
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Malodivo.Types.District
+  ( District(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
+import Data.Hashable (Hashable)
+
+-- | District of the Kindom of Malodivo.
+data District
+  = Palolene
+  | SouthernPalolene
+  | Lakos
+  deriving ( Eq
+           , Hashable
+           , Show
+           , Generic
+           , FromJSON
+           , FromJSONKey
+           , ToJSON
+           , ToJSONKey
+           )
diff --git a/lib/Malodivo/Types/Ministry.hs b/lib/Malodivo/Types/Ministry.hs
new file mode 100644
index 0000000..c3e315b
--- /dev/null
+++ b/lib/Malodivo/Types/Ministry.hs
@@ -0,0 +1,32 @@
+{-|
+Ministries can be encoded to and decoded from JSON:
+
+>>> import Data.Aeson (decode, encode)
+>>> import Data.ByteString.Lazy.Char8 (pack)
+
+>>> encode Defense
+"\"Defense\""
+
+>>> encode [ Defense, Welfare ]
+"[\"Defense\",\"Welfare\"]"
+
+>>> decode . pack $ "[ \"Science\" ]" :: Maybe [Ministry]
+Just [Science]
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Malodivo.Types.Ministry
+  ( Ministry(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Aeson (FromJSON, ToJSON)
+
+-- | Ministry of the Kingdom of Malodivo.
+data Ministry
+  = Defense
+  | Science
+  | Welfare
+  deriving (Show, Generic, FromJSON, ToJSON)