diff options
| -rw-r--r-- | cmd/Main.hs | 5 | ||||
| -rw-r--r-- | cmd/Main/Output.hs | 29 | ||||
| -rw-r--r-- | lib/Malodivo/Budget.hs | 31 | ||||
| -rw-r--r-- | malodivo.cabal | 1 |
4 files changed, 41 insertions, 25 deletions
diff --git a/cmd/Main.hs b/cmd/Main.hs index 69ce114..35a42a6 100644 --- a/cmd/Main.hs +++ b/cmd/Main.hs @@ -18,8 +18,9 @@ import Text.InterpolatedString.Perl6 (qc) import Malodivo.Budget (manyToMany) -import Malodivo.Types.District (di2df) import qualified Main.Input as I +import qualified Main.Output as O +import Malodivo.Types.District (di2df) import Paths_malodivo (version) -- from cabal usageHelp :: String @@ -49,7 +50,7 @@ process = do let allBills = I.bills si suppliedFunds = di2df $ I.districts si in do when (HM.null suppliedFunds) $ die "We needs at least one district" - L.putStr . encode $ manyToMany suppliedFunds allBills + L.putStr . encode . O.encode $ manyToMany suppliedFunds allBills main :: IO () main = do diff --git a/cmd/Main/Output.hs b/cmd/Main/Output.hs new file mode 100644 index 0000000..107e8fd --- /dev/null +++ b/cmd/Main/Output.hs @@ -0,0 +1,29 @@ +{- +This modules describes output data for the command line utlity. +-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Main.Output + ( Output + , encode + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (ToJSON) + +import Malodivo.Types.Bill (Bill) +import Malodivo.Types.District (DistrictFunds, DistrictInfo, df2di) + +type Output = [BillBudget] + +-- | JSON-friendly type. It describes contribution of each district into a bill. +data BillBudget = BillBudget + { bill :: Bill + , districts :: [DistrictInfo] + } deriving (Generic, ToJSON) + +-- | Translate into JSON-friendly format. +encode :: [(Bill, DistrictFunds)] -> Output +encode = map (\(b, df) -> BillBudget {bill = b, districts = df2di df}) diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs index 8d70629..935f86c 100644 --- a/lib/Malodivo/Budget.hs +++ b/lib/Malodivo/Budget.hs @@ -3,12 +3,8 @@ Budget planning in the Kingdom of Malodivo. -} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} - module Malodivo.Budget - ( BillBudget - , billsByMinistry + ( billsByMinistry , manyToOne , manyToMany , manyToManyLimited @@ -16,24 +12,13 @@ module Malodivo.Budget ) where import Control.Arrow ((&&&)) -import GHC.Generics (Generic) -import Data.Aeson (ToJSON) 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 --- | This is output type. It describes contribution of each district into a bill. -data BillBudget = BillBudget - { bill :: B.Bill - , districts :: [D.DistrictInfo] - } deriving (Generic, ToJSON) - -zipBills :: [B.Bill] -> [D.DistrictFunds] -> [BillBudget] -zipBills = zipWith $ \b df -> BillBudget {bill = b, districts = D.df2di df} - {-| Group bills by ministry. @@ -195,12 +180,12 @@ Districts funding multiple bills. No constraints. manyToMany :: D.DistrictFunds -- ^ Amounts of available funds per district. -> [B.Bill] -- ^ Bills requiring funding. - -> [BillBudget] -- ^ Contribution of each district to each bill. -manyToMany df bills = zipBills bills allocated + -> [(B.Bill, D.DistrictFunds)] -- ^ Contribution of each district to each bill. +manyToMany funds bills = zipWith (\b df -> (b, df)) bills allocated where billAmounts = B.amount <$> bills - fundsTotal = sum $ HM.elems df - allocated = flip fundRaising df <$> normalizeDown fundsTotal billAmounts + fundsTotal = sum $ HM.elems funds + allocated = flip fundRaising funds <$> normalizeDown fundsTotal billAmounts {-| Districts funding multiple bills. But each ministry may have been limited @@ -226,8 +211,8 @@ in the amount of funds it can get. >>> let allBills = scienceBills ++ welfareBills >>> let funds = HM.fromList [(D.Lakos, 1000)] ->>> let findBill b = find (\bb -> B.name (bill bb) == B.name b) ->>> let amounts budget = map (B.amount . bill . fromJust) $ map (\b -> findBill b budget) allBills +>>> let findBill b = find (\bb -> B.name (fst bb) == B.name b) +>>> let amounts budget = map (B.amount . fst . fromJust) $ map (\b -> findBill b budget) allBills If all bills of the specific ministry can't get enough funds due to limits imposed on the ministry, @@ -247,7 +232,7 @@ manyToManyLimited :: D.DistrictFunds -- ^ Amounts of available funds per district. -> M.MinistryLimits -- ^ Maximum funds ministries can get. -> [B.Bill] -- ^ Bills requiring funding. - -> [BillBudget] -- ^ Contribution of each district to each bill. + -> [(B.Bill, D.DistrictFunds)] -- ^ Contribution of each district to each bill. manyToManyLimited df ml bills = manyToMany df . concat $ HM.elems byMinistry' where byMinistry = billsByMinistry bills diff --git a/malodivo.cabal b/malodivo.cabal index 0f68889..9b8a191 100644 --- a/malodivo.cabal +++ b/malodivo.cabal @@ -57,6 +57,7 @@ executable malodivo main-is: Main.hs other-modules: Main.Input + Main.Output build-depends: base >= 4.9 && < 5 , aeson |