From c82a64701ff64283e95efbbd6df614cd1e775e52 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Mon, 26 Jun 2017 09:09:20 +0300 Subject: Refactor Mainly because further development will not preserve bill order in lists and we'll need to maintain mapping internally. --- cmd/Main.hs | 6 ++-- cmd/Main/DistrictInfo.hs | 34 --------------------- cmd/Main/Input.hs | 9 +++--- cmd/Main/Output.hs | 30 ------------------ lib/Malodivo/Budget.hs | 69 ++++++++++++++++++------------------------ lib/Malodivo/Types/District.hs | 34 ++++++++++++++++----- lib/Malodivo/Types/Ministry.hs | 25 ++++++++++++++- malodivo.cabal | 2 -- 8 files changed, 87 insertions(+), 122 deletions(-) delete mode 100644 cmd/Main/DistrictInfo.hs delete mode 100644 cmd/Main/Output.hs diff --git a/cmd/Main.hs b/cmd/Main.hs index da28a98..69ce114 100644 --- a/cmd/Main.hs +++ b/cmd/Main.hs @@ -18,9 +18,8 @@ import Text.InterpolatedString.Perl6 (qc) import Malodivo.Budget (manyToMany) -import Main.DistrictInfo (di2df) +import Malodivo.Types.District (di2df) import qualified Main.Input as I -import qualified Main.Output as O import Paths_malodivo (version) -- from cabal usageHelp :: String @@ -48,10 +47,9 @@ process = do Left err -> die err 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 + L.putStr . encode $ manyToMany suppliedFunds allBills main :: IO () main = do diff --git a/cmd/Main/DistrictInfo.hs b/cmd/Main/DistrictInfo.hs deleted file mode 100644 index f4f9ff1..0000000 --- a/cmd/Main/DistrictInfo.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# 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 -. 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 index 63e5942..9c59283 100644 --- a/cmd/Main/Input.hs +++ b/cmd/Main/Input.hs @@ -13,10 +13,11 @@ import GHC.Generics (Generic) import Data.Aeson (FromJSON) import Malodivo.Types.Bill (Bill) - -import Main.DistrictInfo (DistrictInfo) +import Malodivo.Types.District (DistrictInfo) +import Malodivo.Types.Ministry (MinistryInfo) data Input = Input - { bills :: [Bill] - , districts :: [DistrictInfo] + { bills :: [Bill] -- ^ bills requiring funding. + , districts :: [DistrictInfo] -- ^ funds districts can provide. + , ministry :: Maybe [MinistryInfo] -- ^ maximum funds ministries can get. } deriving (Generic, FromJSON) diff --git a/cmd/Main/Output.hs b/cmd/Main/Output.hs deleted file mode 100644 index 1024ecd..0000000 --- a/cmd/Main/Output.hs +++ /dev/null @@ -1,30 +0,0 @@ -{- -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 a707cec..657cf14 100644 --- a/lib/Malodivo/Budget.hs +++ b/lib/Malodivo/Budget.hs @@ -3,20 +3,32 @@ Budget planning in the Kingdom of Malodivo. -} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + module Malodivo.Budget - ( DistrictFunds - , normalizeDown - , manyToOne + ( BillBudget , manyToMany + , manyToOne + , normalizeDown ) where +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 --- | Convenient type. Describes available or allocated funds per 'District'. -type DistrictFunds = HM.HashMap D.District Integer +-- | 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} {-| Normalize list of integers, i. e. proportionally decrease each list element @@ -125,52 +137,29 @@ True -} manyToOne :: - DistrictFunds -- ^ Amounts of available funds per district. + D.DistrictFunds -- ^ Amounts of available funds per district. -> B.Bill -- ^ A bill requiring funding. - -> DistrictFunds -- ^ Contribution of each district. -manyToOne funds bill = fundRaising (B.amount bill) funds + -> D.DistrictFunds -- ^ Contribution of each district. +manyToOne df b = fundRaising (B.amount b) df {-| Districts funding multiple bills. No constraints. - ->>> :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. + D.DistrictFunds -- ^ Amounts of available funds per district. -> [B.Bill] -- ^ Bills requiring funding. - -> [DistrictFunds] -- ^ Contribution of each district to each bill. -manyToMany funds bills = - flip fundRaising funds <$> normalizeDown fundsTotal billAmounts + -> [BillBudget] -- ^ Contribution of each district to each bill. +manyToMany df bills = zipBills bills allocated where billAmounts = B.amount <$> bills - fundsTotal = sum $ HM.elems funds + fundsTotal = sum $ HM.elems df + allocated = flip fundRaising df <$> normalizeDown fundsTotal billAmounts -- | Helper function to maintain DRY and backward compatibility. fundRaising :: Integer -- ^ Amount to be raised. - -> DistrictFunds -- ^ Amounts of available funds per district. - -> DistrictFunds -- ^ Contribution of each district. -fundRaising needed df = HM.fromList $ zip districts funds' + -> D.DistrictFunds -- ^ Amounts of available funds per district. + -> D.DistrictFunds -- ^ Contribution of each district. +fundRaising needed df = HM.fromList $ zip ds (normalizeDown needed fs) where - (districts, funds) = unzip $ HM.toList df - funds' = normalizeDown needed funds + (ds, fs) = unzip $ HM.toList df diff --git a/lib/Malodivo/Types/District.hs b/lib/Malodivo/Types/District.hs index 058377b..2e78634 100644 --- a/lib/Malodivo/Types/District.hs +++ b/lib/Malodivo/Types/District.hs @@ -18,11 +18,17 @@ Just [Lakos] module Malodivo.Types.District ( District(..) + , DistrictFunds + , DistrictInfo(..) + , di2df + , df2di ) where +import Control.Arrow ((&&&)) import GHC.Generics (Generic) import Data.Aeson (FromJSON, ToJSON) +import qualified Data.HashMap.Strict as HM import Data.Hashable (Hashable) -- | District of the Kindom of Malodivo. @@ -30,10 +36,24 @@ data District = Palolene | SouthernPalolene | Lakos - deriving ( Eq - , Hashable - , Show - , Generic - , FromJSON - , ToJSON - ) + deriving (Eq, Hashable, Show, Generic, FromJSON, ToJSON) + +-- | Convenient type. +type DistrictFunds = HM.HashMap District Integer + +{-| +We use this data type instead of 'DistrictFunds' for JSON, +because maps other than @HashMap Text _@ are hard to decode/encode see +. Anyway, we still have type-checked +typos-proof structure. +-} +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/lib/Malodivo/Types/Ministry.hs b/lib/Malodivo/Types/Ministry.hs index c3e315b..f3878d1 100644 --- a/lib/Malodivo/Types/Ministry.hs +++ b/lib/Malodivo/Types/Ministry.hs @@ -18,15 +18,38 @@ Just [Science] module Malodivo.Types.Ministry ( Ministry(..) + , MinistryInfo + , MinistryLimits + , mi2ml ) where +import Control.Arrow ((&&&)) import GHC.Generics (Generic) import Data.Aeson (FromJSON, ToJSON) +import qualified Data.HashMap.Strict as HM +import Data.Hashable (Hashable) -- | Ministry of the Kingdom of Malodivo. data Ministry = Defense | Science | Welfare - deriving (Show, Generic, FromJSON, ToJSON) + deriving (Eq, Hashable, Show, Generic, FromJSON, ToJSON) + +-- | Convenient type. Describes maximum money a ministry can get. +type MinistryLimits = HM.HashMap Ministry Integer + +{-| +We use this data type instead of 'MinistryLimits' for JSON, +because maps other than @HashMap Text _@ are hard to decode/encode see +. Anyway, we still have type-checked +typos-proof structure. +-} +data MinistryInfo = MinistryInfo + { name :: Ministry + , amount :: Integer + } deriving (Generic, FromJSON) + +mi2ml :: [MinistryInfo] -> MinistryLimits +mi2ml = HM.fromListWith (+) . map (name &&& amount) diff --git a/malodivo.cabal b/malodivo.cabal index e767b12..0f68889 100644 --- a/malodivo.cabal +++ b/malodivo.cabal @@ -56,9 +56,7 @@ executable malodivo hs-source-dirs: cmd main-is: Main.hs other-modules: - Main.DistrictInfo Main.Input - Main.Output build-depends: base >= 4.9 && < 5 , aeson -- cgit v1.2.3