bin: budget: re-factor to use hledgerCommandMode
This is preparation to make it part of of hledger.
This commit is contained in:
parent
2342951edc
commit
7cb7554ad1
@ -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
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user