diff options
| -rw-r--r-- | README.md | 68 | ||||
| -rw-r--r-- | cmd/Main.hs | 52 | ||||
| -rw-r--r-- | cmd/Main/DistrictInfo.hs | 34 | ||||
| -rw-r--r-- | cmd/Main/Input.hs | 22 | ||||
| -rw-r--r-- | cmd/Main/Output.hs | 30 | ||||
| -rw-r--r-- | lib/Malodivo/Budget.hs | 56 | ||||
| -rw-r--r-- | lib/Malodivo/Types/District.hs | 4 | ||||
| -rw-r--r-- | malodivo.cabal | 4 | ||||
| -rw-r--r-- | sample/simpleBudget.json | 11 |
9 files changed, 228 insertions, 53 deletions
@@ -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 } ] } |