Support many bills

9 files changed, 228 insertions, 53 deletions

diff --git a/README.md b/README.md
index dd87c22..53b92a0 100644
--- a/README.md
+++ b/README.md
@@ -20,8 +20,7 @@ Command-line utility
 The command-line utility `malodivo` provides a means to process input JSON
 files and output JSON describing the actual amounts that go towards each bill
 by each district.  This utility reads input JSON data from standard input
-and writes output JSON data to standard output.  _The format of output is
-unstable and subject to change_.
+and writes output JSON data to standard output.
 
 Usage
 -----
@@ -39,13 +38,12 @@ Options:
 Examples
 --------
 
-We would get this:
+Command:
 ```
 $ malodivo < sample/simpleBudget.json
-[["Lakos",100],["Palolene",66],["SouthernPalolene",133]]
 ```
 
-with this file ([sample/simpleBudget.json](sample/simpleBudget.json)):
+Input:
 ```json
 {
   "bills": [
@@ -53,22 +51,76 @@ with this file ([sample/simpleBudget.json](sample/simpleBudget.json)):
       "name": "An Act to Construct the Great Wall of Malodivo",
       "ministry": "Defense",
       "amount": 300
+    },
+    {
+      "name": "An Act to Construct Shelters for the Homeless",
+      "ministry": "Welfare",
+      "amount": 400
     }
   ],
   "districts": [
     {
       "name": "Palolene",
-      "availableFunds": 200
+      "amount": 200
     },
     {
       "name": "SouthernPalolene",
-      "availableFunds": 400
+      "amount": 400
     },
     {
       "name": "Lakos",
-      "availableFunds": 300
+      "amount": 300
     }
   ]
 }
 ```
 
+Output:
+```json
+[
+  {
+    "bill": {
+      "amount": 300,
+      "name": "An Act to Construct the Great Wall of Malodivo",
+      "ministry": "Defense"
+    },
+    "districts": [
+      {
+        "amount": 100,
+        "name": "Lakos"
+      },
+      {
+        "amount": 66,
+        "name": "Palolene"
+      },
+      {
+        "amount": 133,
+        "name": "SouthernPalolene"
+      }
+    ]
+  },
+  {
+    "bill": {
+      "amount": 400,
+      "name": "An Act to Construct Shelters for the Homeless",
+      "ministry": "Welfare"
+    },
+    "districts": [
+      {
+        "amount": 133,
+        "name": "Lakos"
+      },
+      {
+        "amount": 88,
+        "name": "Palolene"
+      },
+      {
+        "amount": 177,
+        "name": "SouthernPalolene"
+      }
+    ]
+  }
+]
+
+```
+
diff --git a/cmd/Main.hs b/cmd/Main.hs
index bbc45cb..da28a98 100644
--- a/cmd/Main.hs
+++ b/cmd/Main.hs
@@ -1,32 +1,30 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE QuasiQuotes #-}
 
 module Main
   ( main
   ) where
 
-import Control.Arrow ((&&&))
 import Control.Monad (when)
 import Data.Version (showVersion)
-import GHC.Generics (Generic)
 import System.Environment (getArgs)
 import System.Exit (die)
 
-import Data.Aeson (FromJSON, eitherDecode, encode)
+import Data.Aeson (eitherDecode, encode)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.HashMap.Strict as HM
-import qualified System.Console.Docopt.NoTH as O
+import System.Console.Docopt.NoTH
+       (isPresent, longOption, parseArgsOrExit, parseUsageOrExit, usage)
 import Text.InterpolatedString.Perl6 (qc)
 
-import Malodivo.Budget (manyToOne)
-import Malodivo.Types.Bill (Bill)
-import Malodivo.Types.District (District)
+import Malodivo.Budget (manyToMany)
 
+import Main.DistrictInfo (di2df)
+import qualified Main.Input as I
+import qualified Main.Output as O
 import Paths_malodivo (version) -- from cabal
 
-usage :: String
-usage =
+usageHelp :: String
+usageHelp =
   "malodivo " ++
   showVersion version ++
   " - budget planning tool for the Kingdom of Malodivo" ++
@@ -41,36 +39,24 @@ Options:
 
   -h, --help               Show this message and exit
 
-
 |]
 
-data DistrictInfo = DistrictInfo
-  { name :: District
-  , availableFunds :: Integer
-  } deriving (Generic, FromJSON)
-
-data SimpleInput = SimpleInput
-  { bills :: [Bill]
-  , districts :: [DistrictInfo]
-  } deriving (Generic, FromJSON)
-
 process :: IO ()
 process = do
   input <- L.getContents
   case eitherDecode input of
     Left err -> die err
-    Right si -> do
-      let nbills = length . bills $ si
-          funds =
-            HM.fromListWith (+) . map (name &&& availableFunds) $ districts si
-      when (nbills /= 1) $ die "We needs exactly one bill in input"
-      when (HM.null funds) $ die "We needs at least one district"
-      L.putStr . encode $ manyToOne funds (head . bills $ si)
+    Right si ->
+      let allBills = I.bills si
+          billFunds = manyToMany suppliedFunds allBills
+          suppliedFunds = di2df $ I.districts si
+      in do when (HM.null suppliedFunds) $ die "We needs at least one district"
+            L.putStr . encode $ O.zipBills allBills billFunds
 
 main :: IO ()
 main = do
-  doco <- O.parseUsageOrExit usage
-  args <- O.parseArgsOrExit doco =<< getArgs
-  if args `O.isPresent` O.longOption "help"
-    then putStrLn $ O.usage doco
+  doco <- parseUsageOrExit usageHelp
+  args <- parseArgsOrExit doco =<< getArgs
+  if args `isPresent` longOption "help"
+    then putStrLn $ usage doco
     else process
diff --git a/cmd/Main/DistrictInfo.hs b/cmd/Main/DistrictInfo.hs
new file mode 100644
index 0000000..f4f9ff1
--- /dev/null
+++ b/cmd/Main/DistrictInfo.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main.DistrictInfo
+  ( DistrictInfo(..)
+  , di2df
+  , df2di
+  ) where
+
+import Control.Arrow ((&&&))
+import GHC.Generics (Generic)
+
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.HashMap.Strict as HM
+
+import Malodivo.Budget (DistrictFunds)
+import Malodivo.Types.District (District)
+
+{-|
+We use this data type instead of 'DistrictFunds', because
+maps other than @HashMap Text _@ are hard to decode/encode see
+<https://github.com/bos/aeson/issues/79>.  Anyway, we still have type-checked
+typos-proof structure, and build 'DistrictFunds' out of it.
+-}
+data DistrictInfo = DistrictInfo
+  { name :: District
+  , amount :: Integer
+  } deriving (Generic, FromJSON, ToJSON)
+
+di2df :: [DistrictInfo] -> DistrictFunds
+di2df = HM.fromListWith (+) . map (name &&& amount)
+
+df2di :: DistrictFunds -> [DistrictInfo]
+df2di = map (\(n, a) -> DistrictInfo {name = n, amount = a}) . HM.toList
diff --git a/cmd/Main/Input.hs b/cmd/Main/Input.hs
new file mode 100644
index 0000000..63e5942
--- /dev/null
+++ b/cmd/Main/Input.hs
@@ -0,0 +1,22 @@
+{-
+This modules describes input data for the command line utlity.
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main.Input
+  ( Input(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Aeson (FromJSON)
+
+import Malodivo.Types.Bill (Bill)
+
+import Main.DistrictInfo (DistrictInfo)
+
+data Input = Input
+  { bills :: [Bill]
+  , districts :: [DistrictInfo]
+  } deriving (Generic, FromJSON)
diff --git a/cmd/Main/Output.hs b/cmd/Main/Output.hs
new file mode 100644
index 0000000..1024ecd
--- /dev/null
+++ b/cmd/Main/Output.hs
@@ -0,0 +1,30 @@
+{-
+This modules describes output data for the command line utlity.
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main.Output
+  ( BillBudget(..)
+  , zipBills
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Aeson (ToJSON)
+
+import Malodivo.Budget (DistrictFunds)
+import Malodivo.Types.Bill (Bill)
+
+import Main.DistrictInfo (DistrictInfo, df2di)
+
+-- | This is output type. It describes contribution of each district into a bill.
+data BillBudget = BillBudget
+  { bill :: Bill
+  , districts :: [DistrictInfo]
+  } deriving (Generic, ToJSON)
+
+zipBills :: [Bill] -> [DistrictFunds] -> [BillBudget]
+zipBills = zipWith zipper
+  where
+    zipper b df = BillBudget {bill = b, districts = df2di df}
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
            )
diff --git a/malodivo.cabal b/malodivo.cabal
index 3719c92..1e5062d 100644
--- a/malodivo.cabal
+++ b/malodivo.cabal
@@ -55,6 +55,10 @@ executable malodivo
   ghc-options: -Wall -static
   hs-source-dirs: cmd
   main-is: Main.hs
+  other-modules:
+    Main.DistrictInfo
+    Main.Input
+    Main.Output
   build-depends:
       base >= 4.9 && < 5
     , aeson
diff --git a/sample/simpleBudget.json b/sample/simpleBudget.json
index 551898a..4d52700 100644
--- a/sample/simpleBudget.json
+++ b/sample/simpleBudget.json
@@ -4,20 +4,25 @@
       "name": "An Act to Construct the Great Wall of Malodivo",
       "ministry": "Defense",
       "amount": 300
+    },
+    {
+      "name": "An Act to Construct Shelters for the Homeless",
+      "ministry": "Welfare",
+      "amount": 400
     }
   ],
   "districts": [
     {
       "name": "Palolene",
-      "availableFunds": 200
+      "amount": 200
     },
     {
       "name": "SouthernPalolene",
-      "availableFunds": 400
+      "amount": 400
     },
     {
       "name": "Lakos",
-      "availableFunds": 300
+      "amount": 300
     }
   ]
 }