aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cmd/Main.hs6
-rw-r--r--cmd/Main/DistrictInfo.hs34
-rw-r--r--cmd/Main/Input.hs9
-rw-r--r--cmd/Main/Output.hs30
-rw-r--r--lib/Malodivo/Budget.hs69
-rw-r--r--lib/Malodivo/Types/District.hs34
-rw-r--r--lib/Malodivo/Types/Ministry.hs25
-rw-r--r--malodivo.cabal2
8 files changed, 87 insertions, 122 deletions
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
-<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
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
+<https://github.com/bos/aeson/issues/79>. 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
+<https://github.com/bos/aeson/issues/79>. 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-21 12:33:05 +0000