diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2017-06-24 13:36:19 +0300 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2017-06-24 13:44:42 +0300 |
commit | ebe8cba9837872de3dd611d6cd615425c51fefec (patch) | |
tree | 776af0f6361d5727f65143b9d8066b85a180c2b2 /cmd | |
parent | 2ed435c73d0bc80a6b0d9d16a9fd0e9a0b464ed2 (diff) | |
download | molodivo-ebe8cba9837872de3dd611d6cd615425c51fefec.tar.gz |
Support many bills
Diffstat (limited to 'cmd')
-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 |
4 files changed, 105 insertions, 33 deletions
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} |