bin: budget: re-factor to use hledgerCommandMode

This is preparation to make it part of of hledger.
This commit is contained in:
Mykola Orliuk 2017-10-02 00:53:21 +02:00 committed by Simon Michael
parent 2342951edc
commit 7cb7554ad1

View File

@ -5,7 +5,7 @@
--package cmdargs --package cmdargs
--package text --package text
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
{- {-
hledger-budget REPORT-COMMAND [--no-offset] [--no-buckets] [OPTIONS...] hledger-budget REPORT-COMMAND [--no-offset] [--no-buckets] [OPTIONS...]
@ -142,25 +142,41 @@ $ hledger budget -- bal --period 'monthly to last month' --no-offset --average
import Control.Arrow (first) import Control.Arrow (first)
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import Data.String.Here
import System.Console.CmdArgs import System.Console.CmdArgs
import Hledger.Cli import Hledger.Cli
import Hledger.Cli.Main (mainmode)
import Hledger.Data.AutoTransaction import Hledger.Data.AutoTransaction
budgetmode :: Mode RawOpts
budgetmode = (hledgerCommandMode
[here| budget
Perform various reporting commands taking into account budgeting entries in journal.
|]
[] -- ungroupped flags
[("\nBudgeting", budgetFlags), generalflagsgroup2] -- groupped flags
[] -- hidden flags
([], Nothing)
) { modeGroupModes = Group
{ groupUnnamed = map fst actions
, groupNamed = []
, groupHidden = []
}
}
budgetFlags :: [Flag RawOpts] budgetFlags :: [Flag RawOpts]
budgetFlags = budgetFlags =
[ flagNone ["no-buckets"] (setboolopt "no-buckets") "show all accounts besides mentioned in periodic transactions" [ flagNone ["no-buckets"] (setboolopt "no-buckets") "show all accounts besides mentioned in periodic transactions"
, flagNone ["no-offset"] (setboolopt "no-offset") "do not add up periodic transactions" , flagNone ["no-offset"] (setboolopt "no-offset") "do not add up periodic transactions"
] ]
actions :: [(Mode RawOpts, CliOpts -> IO ())] actions :: [(Mode RawOpts, CliOpts -> Journal -> IO ())]
actions = first injectBudgetFlags <$> actions = first injectBudgetFlags <$>
[ (balancemode, flip withJournalDo' balance) [ (balancemode, balance)
, (balancesheetmode, flip withJournalDo' balancesheet) , (balancesheetmode, balancesheet)
, (cashflowmode, flip withJournalDo' cashflow) , (cashflowmode, cashflow)
, (incomestatementmode, flip withJournalDo' incomestatement) , (incomestatementmode, incomestatement)
, (registermode, flip withJournalDo' register) , (registermode, register)
, (printmode, flip withJournalDo' print') , (printmode, print')
] ]
injectBudgetFlags :: Mode RawOpts -> Mode RawOpts injectBudgetFlags :: Mode RawOpts -> Mode RawOpts
@ -178,24 +194,13 @@ injectFlags section flags mode0 = mode' where
([g], gs) -> (fst g, snd g ++ flags) : gs ([g], gs) -> (fst g, snd g ++ flags) : gs
_ -> (section, flags) : namedFlags0 _ -> (section, flags) : namedFlags0
cmdmode :: Mode RawOpts
cmdmode = (mainmode [])
{ modeNames = ["hledger-budget"]
, modeGroupModes = Group
{ groupUnnamed = map fst actions
, groupNamed = []
, groupHidden = []
}
}
journalBalanceTransactions' :: CliOpts -> Journal -> IO Journal journalBalanceTransactions' :: CliOpts -> Journal -> IO Journal
journalBalanceTransactions' opts j = do journalBalanceTransactions' opts j = do
let assrt = not . ignore_assertions_ $ inputopts_ opts let assrt = not . ignore_assertions_ $ inputopts_ opts
either error' return $ journalBalanceTransactions assrt j either error' return $ journalBalanceTransactions assrt j
withJournalDo' :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO () budgetWrapper :: (CliOpts -> Journal -> IO ()) -> CliOpts -> Journal -> IO ()
withJournalDo' opts = withJournalDo opts . wrapper where budgetWrapper f opts' j = do
wrapper f opts' j = do
-- use original transactions as input for journalBalanceTransactions to re-infer balances/prices -- use original transactions as input for journalBalanceTransactions to re-infer balances/prices
let modifier = originalTransaction . foldr (flip (.) . runModifierTransaction') id mtxns let modifier = originalTransaction . foldr (flip (.) . runModifierTransaction') id mtxns
runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any
@ -234,9 +239,12 @@ mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
main :: IO () main :: IO ()
main = do main = do
rawopts <- fmap decodeRawOpts . processArgs $ cmdmode rawopts <- fmap decodeRawOpts . processArgs $ budgetmode
opts <- rawOptsToCliOpts rawopts opts <- rawOptsToCliOpts rawopts
withJournalDo opts budget
budget :: CliOpts -> Journal -> IO ()
budget opts journal =
case find (\e -> command_ opts `elem` modeNames (fst e)) actions of case find (\e -> command_ opts `elem` modeNames (fst e)) actions of
Just (amode, _) | "help" `elem` map fst (rawopts_ opts) -> print amode Just (_, action) -> budgetWrapper action opts journal
Just (_, action) -> action opts Nothing -> print budgetmode
Nothing -> print cmdmode