From 0f1837816dd26055767fe524d483df5c2c091b8b Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 4 Jun 2021 22:40:10 +1000 Subject: [PATCH] lib,cli,ui,web: Add check balancednoautoconversion command, which checks that transactions are balanced possibly using explicit prices, but without inferring any prices. This is included in --strict mode. Renames check autobalanced to check balancedwithautoconversion. --- hledger-lib/Hledger/Data/Journal.hs | 23 +++--- hledger-lib/Hledger/Data/Transaction.hs | 75 +++++++++++-------- hledger-lib/Hledger/Read/Common.hs | 46 ++++++------ hledger-lib/Hledger/Read/CsvReader.hs | 2 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 12 +-- hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/ErrorScreen.hs | 2 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger-ui/Hledger/UI/UIState.hs | 4 +- hledger-web/Hledger/Web/Widget/AddForm.hs | 2 +- hledger/Hledger/Cli/Commands/Add.hs | 4 +- hledger/Hledger/Cli/Commands/Balance.hs | 4 +- hledger/Hledger/Cli/Commands/Check.hs | 20 ++--- hledger/Hledger/Cli/Commands/Check.md | 5 +- hledger/Hledger/Cli/Commands/Diff.hs | 2 +- hledger/Hledger/Cli/Commands/Import.hs | 2 +- hledger/Hledger/Cli/Utils.hs | 4 +- .../test/check-balancednoautoconversion.test | 8 ++ hledger/test/journal/transaction-prices.test | 29 ++++--- 21 files changed, 141 insertions(+), 111 deletions(-) create mode 100644 hledger/test/check-balancednoautoconversion.test diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 1e3691841..d2e6aacf1 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -717,7 +717,7 @@ journalModifyTransactions d j = -- | Check any balance assertions in the journal and return an error message -- if any of them fail (or if the transaction balancing they require fails). journalCheckBalanceAssertions :: Journal -> Maybe String -journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True +journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions def -- "Transaction balancing", including: inferring missing amounts, -- applying balance assignments, checking transaction balancedness, @@ -817,13 +817,14 @@ updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions} -> -- -- This does multiple things at once because amount inferring, balance -- assignments, balance assertions and posting dates are interdependent. -journalBalanceTransactions :: Bool -> Journal -> Either String Journal -journalBalanceTransactions assrt j' = +journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal +journalBalanceTransactions bopts' j' = let -- ensure transactions are numbered, so we can store them by number j@Journal{jtxns=ts} = journalNumberTransactions j' -- display precisions used in balanced checking styles = Just $ journalCommodityStyles j + bopts = bopts'{commodity_styles_=styles} -- balance assignments will not be allowed on these txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j in @@ -840,7 +841,7 @@ journalBalanceTransactions assrt j' = -- and leaving the others for later. The balanced ones are split into their postings. -- The postings and not-yet-balanced transactions remain in the same relative order. psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case - t | null $ assignmentPostings t -> case balanceTransaction styles t of + t | null $ assignmentPostings t -> case balanceTransaction bopts t of Left e -> throwError e Right t' -> do lift $ writeArray balancedtxns (tindex t') t' @@ -850,7 +851,7 @@ journalBalanceTransactions assrt j' = -- 2. Sort these items by date, preserving the order of same-day items, -- and step through them while keeping running account balances, runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j) - flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do + flip runReaderT (BalancingState styles txnmodifieraccts (not $ ignore_assertions_ bopts) runningbals balancedtxns) $ do -- performing balance assignments in, and balancing, the remaining transactions, -- and checking balance assertions as each posting is processed. void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts @@ -879,7 +880,7 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do ps' <- mapM (addOrAssignAmountAndCheckAssertionB . postingStripPrices) ps -- infer any remaining missing amounts, and make sure the transaction is now fully balanced styles <- R.reader bsStyles - case balanceTransactionHelper styles t{tpostings=ps'} of + case balanceTransactionHelper balancingOpts{commodity_styles_=styles} t{tpostings=ps'} of Left err -> throwError err Right (t', inferredacctsandamts) -> do -- for each amount just inferred, update the running balance @@ -1404,7 +1405,7 @@ journalApplyAliases aliases j = -- liabilities:debts $1 -- assets:bank:checking -- -Right samplejournal = journalBalanceTransactions False $ +Right samplejournal = journalBalanceTransactions def $ nulljournal {jtxns = [ txnTieKnot $ Transaction { @@ -1547,7 +1548,7 @@ tests_Journal = tests "Journal" [ ,tests "journalBalanceTransactions" [ test "balance-assignment" $ do - let ej = journalBalanceTransactions True $ + let ej = journalBalanceTransactions def $ --2019/01/01 -- (a) = 1 nulljournal{ jtxns = [ @@ -1558,7 +1559,7 @@ tests_Journal = tests "Journal" [ (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] ,test "same-day-1" $ do - assertRight $ journalBalanceTransactions True $ + assertRight $ journalBalanceTransactions def $ --2019/01/01 -- (a) = 1 --2019/01/01 @@ -1569,7 +1570,7 @@ tests_Journal = tests "Journal" [ ]} ,test "same-day-2" $ do - assertRight $ journalBalanceTransactions True $ + assertRight $ journalBalanceTransactions def $ --2019/01/01 -- (a) 2 = 2 --2019/01/01 @@ -1587,7 +1588,7 @@ tests_Journal = tests "Journal" [ ]} ,test "out-of-order" $ do - assertRight $ journalBalanceTransactions True $ + assertRight $ journalBalanceTransactions def $ --2019/1/2 -- (a) 1 = 2 --2019/1/1 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 7dac4d6bb..5f0447f0e 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -28,6 +28,8 @@ module Hledger.Data.Transaction ( virtualPostings, balancedVirtualPostings, transactionsPostings, + BalancingOpts(..), + balancingOpts, isTransactionBalanced, balanceTransaction, balanceTransactionHelper, @@ -61,7 +63,7 @@ module Hledger.Data.Transaction ( ) where -import Data.Default (def) +import Data.Default (Default(..)) import Data.Foldable (asum) import Data.List (intercalate, partition) import Data.List.Extra (nubSort) @@ -352,6 +354,21 @@ balancedVirtualPostings = filter isBalancedVirtual . tpostings transactionsPostings :: [Transaction] -> [Posting] transactionsPostings = concatMap tpostings +data BalancingOpts = BalancingOpts + { ignore_assertions_ :: Bool -- ^ Ignore balance assertions + , infer_prices_ :: Bool -- ^ Infer prices in unbalanced multicommodity amounts + , commodity_styles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles + } deriving (Show) + +instance Default BalancingOpts where def = balancingOpts + +balancingOpts :: BalancingOpts +balancingOpts = BalancingOpts + { ignore_assertions_ = False + , infer_prices_ = True + , commodity_styles_ = Nothing + } + -- | Check that this transaction would appear balanced to a human when displayed. -- On success, returns the empty list, otherwise one or more error messages. -- @@ -369,13 +386,13 @@ transactionsPostings = concatMap tpostings -- 3. Does the amounts' sum appear non-zero when displayed ? -- (using the given display styles if provided) -- -transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String] -transactionCheckBalanced mstyles t = errs +transactionCheckBalanced :: BalancingOpts -> Transaction -> [String] +transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs where (rps, bvps) = (realPostings t, balancedVirtualPostings t) -- check for mixed signs, detecting nonzeros at display precision - canonicalise = maybe id canonicaliseMixedAmount mstyles + canonicalise = maybe id canonicaliseMixedAmount commodity_styles_ signsOk ps = case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of nonzeros | length nonzeros >= 2 @@ -402,8 +419,8 @@ transactionCheckBalanced mstyles t = errs | otherwise = "" -- | Legacy form of transactionCheckBalanced. -isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool -isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles +isTransactionBalanced :: BalancingOpts -> Transaction -> Bool +isTransactionBalanced bopts = null . transactionCheckBalanced bopts -- | Balance this transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0, @@ -419,22 +436,22 @@ isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles -- if provided, so that the result agrees with the numbers users can see. -- balanceTransaction :: - Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles + BalancingOpts -> Transaction -> Either String Transaction -balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles +balanceTransaction bopts = fmap fst . balanceTransactionHelper bopts -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- use one of those instead. It also returns a list of accounts -- and amounts that were inferred. balanceTransactionHelper :: - Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles + BalancingOpts -> Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) -balanceTransactionHelper mstyles t = do - (t', inferredamtsandaccts) <- - inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t - case transactionCheckBalanced mstyles t' of +balanceTransactionHelper bopts t = do + (t', inferredamtsandaccts) <- inferBalancingAmount (fromMaybe M.empty $ commodity_styles_ bopts) $ + if infer_prices_ bopts then inferBalancingPrices t else t + case transactionCheckBalanced bopts t' of [] -> Right (txnTieKnot t', inferredamtsandaccts) errs -> Left $ transactionBalanceError t' errs @@ -846,8 +863,7 @@ tests_Transaction = , tests "balanceTransaction" [ test "detect unbalanced entry, sign error" $ assertLeft - (balanceTransaction - Nothing + (balanceTransaction def (Transaction 0 "" @@ -862,8 +878,7 @@ tests_Transaction = [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}])) ,test "detect unbalanced entry, multiple missing amounts" $ assertLeft $ - balanceTransaction - Nothing + balanceTransaction def (Transaction 0 "" @@ -880,8 +895,7 @@ tests_Transaction = ]) ,test "one missing amount is inferred" $ (pamount . last . tpostings <$> - balanceTransaction - Nothing + balanceTransaction def (Transaction 0 "" @@ -897,8 +911,7 @@ tests_Transaction = Right (mixedAmount $ usd (-1)) ,test "conversion price is inferred" $ (pamount . head . tpostings <$> - balanceTransaction - Nothing + balanceTransaction def (Transaction 0 "" @@ -916,8 +929,7 @@ tests_Transaction = Right (mixedAmount $ usd 1.35 @@ eur 1) ,test "balanceTransaction balances based on cost if there are unit prices" $ assertRight $ - balanceTransaction - Nothing + balanceTransaction def (Transaction 0 "" @@ -934,8 +946,7 @@ tests_Transaction = ]) ,test "balanceTransaction balances based on cost if there are total prices" $ assertRight $ - balanceTransaction - Nothing + balanceTransaction def (Transaction 0 "" @@ -954,7 +965,7 @@ tests_Transaction = , tests "isTransactionBalanced" [ test "detect balanced" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -972,7 +983,7 @@ tests_Transaction = ,test "detect unbalanced" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -990,7 +1001,7 @@ tests_Transaction = ,test "detect unbalanced, one posting" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -1005,7 +1016,7 @@ tests_Transaction = [posting {paccount = "b", pamount = mixedAmount (usd 1.00)}] ,test "one zero posting is considered balanced for now" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -1020,7 +1031,7 @@ tests_Transaction = [posting {paccount = "b", pamount = mixedAmount (usd 0)}] ,test "virtual postings don't need to balance" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -1039,7 +1050,7 @@ tests_Transaction = ,test "balanced virtual postings need to balance among themselves" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" @@ -1057,7 +1068,7 @@ tests_Transaction = ] ,test "balanced virtual postings need to balance among themselves (2)" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced def $ Transaction 0 "" diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index d4243b93c..ad2008e29 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -196,13 +196,12 @@ data InputOpts = InputOpts { ,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV) ,aliases_ :: [String] -- ^ account name aliases to apply ,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data - ,ignore_assertions_ :: Bool -- ^ don't check balance assertions ,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed - ,commoditystyles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ optional commodity display styles affecting all files - ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared) + ,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions + ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred) } deriving (Show) instance Default InputOpts where def = definputopts @@ -213,30 +212,31 @@ definputopts = InputOpts , mrules_file_ = Nothing , aliases_ = [] , anon_ = False - , ignore_assertions_ = False , new_ = False , new_save_ = True , pivot_ = "" , auto_ = False - , commoditystyles_ = Nothing + , balancingopts_ = def , strict_ = False } rawOptsToInputOpts :: RawOpts -> InputOpts rawOptsToInputOpts rawopts = InputOpts{ - -- files_ = listofstringopt "file" rawopts - mformat_ = Nothing - ,mrules_file_ = maybestringopt "rules-file" rawopts - ,aliases_ = listofstringopt "alias" rawopts - ,anon_ = boolopt "anon" rawopts - ,ignore_assertions_ = boolopt "ignore-assertions" rawopts - ,new_ = boolopt "new" rawopts - ,new_save_ = True - ,pivot_ = stringopt "pivot" rawopts - ,auto_ = boolopt "auto" rawopts - ,commoditystyles_ = Nothing - ,strict_ = boolopt "strict" rawopts - } + -- files_ = listofstringopt "file" rawopts + mformat_ = Nothing + ,mrules_file_ = maybestringopt "rules-file" rawopts + ,aliases_ = listofstringopt "alias" rawopts + ,anon_ = boolopt "anon" rawopts + ,new_ = boolopt "new" rawopts + ,new_save_ = True + ,pivot_ = stringopt "pivot" rawopts + ,auto_ = boolopt "auto" rawopts + ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts + , infer_prices_ = not noinferprice + } + ,strict_ = boolopt "strict" rawopts + } + where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion" --- ** parsing utilities @@ -324,11 +324,11 @@ parseAndFinaliseJournal' parser iopts f txt = do -- - infer transaction-implied market prices from transaction prices -- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal -journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f txt pj = do +journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj = do t <- liftIO getClockTime d <- liftIO getCurrentDay let pj' = - pj{jglobalcommoditystyles=fromMaybe M.empty commoditystyles_} -- save any global commodity styles + pj{jglobalcommoditystyles=fromMaybe M.empty $ commodity_styles_ balancingopts_} -- save any global commodity styles & journalAddFile (f, txt) -- save the main file's info & journalSetLastReadTime t -- save the last read time & journalReverse -- convert all lists to the order they were parsed @@ -353,11 +353,11 @@ journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f t then -- Auto postings are not active. -- Balance all transactions and maybe check balance assertions. - journalBalanceTransactions (not ignore_assertions_) + journalBalanceTransactions balancingopts_ else \j -> do -- Either monad -- Auto postings are active. -- Balance all transactions without checking balance assertions, - j' <- journalBalanceTransactions False j + j' <- journalBalanceTransactions balancingopts_{ignore_assertions_=True} j -- then add the auto postings -- (Note adding auto postings after balancing means #893b fails; -- adding them before balancing probably means #893a, #928, #938 fail.) @@ -367,7 +367,7 @@ journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f t -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) j''' <- journalApplyCommodityStyles j'' -- then check balance assertions. - journalBalanceTransactions (not ignore_assertions_) j''' + journalBalanceTransactions balancingopts_ j''' ) & fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 1a475a0e1..6a8ab5125 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -116,7 +116,7 @@ parse iopts f t = do -- apply any command line account aliases. Can fail with a bad replacement pattern. in case journalApplyAliases (aliasesFromOpts iopts) pj' of Left e -> throwError e - Right pj'' -> journalFinalise iopts{ignore_assertions_=True} f t pj'' + Right pj'' -> journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f t pj'' --- ** reading rules files --- *** rules utilities diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index fe4009f3a..1d8c212cc 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -78,7 +78,7 @@ balanceReport rspec j = (rows, total) -- tests Right samplejournal2 = - journalBalanceTransactions False + journalBalanceTransactions balancingOpts nulljournal{ jtxns = [ txnTieKnot Transaction{ diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 4b9f053e5..d3a73bc63 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -63,8 +63,8 @@ type BudgetDisplayCell = ((Text, Int), Maybe ((Text, Int), Maybe (Text, Int))) -- from all periodic transactions, calculate actual balance changes -- from the regular transactions, and compare these to get a 'BudgetReport'. -- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames). -budgetReport :: ReportSpec -> Bool -> DateSpan -> Journal -> BudgetReport -budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport +budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport +budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport where -- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled -- and that reports with and without --empty make sense when compared side by side @@ -79,7 +79,7 @@ budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport concatMap (`runPeriodicTransaction` reportspan) $ jperiodictxns j actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j - budgetj = journalAddBudgetGoalTransactions assrt ropts reportspan j + budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j actualreport@(PeriodicReport actualspans _ _) = dbg5 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = @@ -97,9 +97,9 @@ budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport -- Budget goal transactions are similar to forecast transactions except -- their purpose and effect is to define balance change goals, per account and period, -- for BudgetReport. -journalAddBudgetGoalTransactions :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal -journalAddBudgetGoalTransactions assrt _ropts reportspan j = - either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts } -- PARTIAL: +journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal +journalAddBudgetGoalTransactions bopts _ropts reportspan j = + either error' id $ journalBalanceTransactions bopts j{ jtxns = budgetts } -- PARTIAL: where budgetspan = dbg3 "budget span" $ reportspan budgetts = diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index b17e8bdeb..c0df166f7 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -163,7 +163,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}} <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts) <+> borderDepthStr mdepth <+> str (" ("++curidx++"/"++totidx++")") - <+> (if ignore_assertions_ $ inputopts_ copts + <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "") where diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index 858fc1867..c4edefe88 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -196,7 +196,7 @@ enableForecastPreservingPeriod ui copts@CliOpts{reportspec_=rspec@ReportSpec{rsO -- are disabled, do nothing. uiCheckBalanceAssertions :: Day -> UIState -> UIState uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} - | ignore_assertions_ $ inputopts_ copts = ui + | ignore_assertions_ . balancingopts_ $ inputopts_ copts = ui | otherwise = case journalCheckBalanceAssertions j of Nothing -> ui diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index cb8a1993a..1e0d2a25c 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -218,7 +218,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}} <+> str "/" <+> total <+> str ")" - <+> (if ignore_assertions_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "") + <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "") where togglefilters = case concat [ diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index a4b1ade5c..44ab0d19b 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -95,7 +95,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ <+> togglefilters <+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts) <+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")") - <+> (if ignore_assertions_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "") + <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "") where togglefilters = case concat [ diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 7357eecd3..ee48f1dc4 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -186,8 +186,8 @@ toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspe -- | Toggle the ignoring of balance assertions. toggleIgnoreBalanceAssertions :: UIState -> UIState -toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} = - ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{ignore_assertions_=not $ ignore_assertions_ iopts}}}} +toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts@InputOpts{balancingopts_=bopts}}}} = + ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{balancingopts_=bopts{ignore_assertions_=not $ ignore_assertions_ bopts}}}}} -- | Step through larger report periods, up to all. growReportPeriod :: Day -> UIState -> UIState diff --git a/hledger-web/Hledger/Web/Widget/AddForm.hs b/hledger-web/Hledger/Web/Widget/AddForm.hs index ed5a3dd1e..ad31ef961 100644 --- a/hledger-web/Hledger/Web/Widget/AddForm.hs +++ b/hledger-web/Hledger/Web/Widget/AddForm.hs @@ -110,7 +110,7 @@ validateTransaction :: -> FormResult Transaction validateTransaction dateRes descRes postingsRes = case makeTransaction <$> dateRes <*> descRes <*> postingsRes of - FormSuccess txn -> case balanceTransaction Nothing txn of + FormSuccess txn -> case balanceTransaction balancingOpts txn of Left e -> FormFailure [T.pack e] Right txn' -> FormSuccess txn' x -> x diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 4ace78bbd..27f5e0519 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -203,7 +203,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) ,tcomment=txnCmnt ,tpostings=esPostings } - case balanceTransaction Nothing t of -- imprecise balancing (?) + case balanceTransaction balancingOpts t of -- imprecise balancing (?) Right t' -> confirmedTransactionWizard prevInput es (EndStage t' : stack) Left err -> do @@ -292,7 +292,7 @@ descriptionAndCommentWizard PrevInput{..} EntryState{..} = do return $ Just (desc, comment) postingsBalanced :: [Posting] -> Bool -postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps} +postingsBalanced ps = isRight $ balanceTransaction balancingOpts nulltransaction{tpostings=ps} accountWizard PrevInput{..} EntryState{..} = do let pnum = length esPostings + 1 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 59753cf22..2fc6a4d3e 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -313,9 +313,7 @@ balance :: CliOpts -> Journal -> IO () balance opts@CliOpts{reportspec_=rspec} j = case reporttype_ of BudgetReport -> do -- single or multi period budget report let reportspan = reportSpan j rspec - budgetreport = budgetReport rspec assrt reportspan j - where - assrt = not $ ignore_assertions_ $ inputopts_ opts + budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) reportspan j render = case fmt of "txt" -> budgetReportAsText ropts "json" -> (<>"\n") . toJsonText diff --git a/hledger/Hledger/Cli/Commands/Check.hs b/hledger/Hledger/Cli/Commands/Check.hs index 95661831b..4d5d1adae 100644 --- a/hledger/Hledger/Cli/Commands/Check.hs +++ b/hledger/Hledger/Cli/Commands/Check.hs @@ -9,17 +9,18 @@ module Hledger.Cli.Commands.Check ( ,check ) where +import Data.Char (toLower,toUpper) +import Data.Either (partitionEithers) +import Data.List (isPrefixOf, find) +import Control.Monad (forM_) +import System.Console.CmdArgs.Explicit +import System.Exit (exitFailure) +import System.IO (stderr, hPutStrLn) + import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates) import Hledger.Cli.Commands.Check.Uniqueleafnames (journalCheckUniqueleafnames) -import System.Console.CmdArgs.Explicit -import Data.Either (partitionEithers) -import Data.Char (toLower,toUpper) -import Data.List (isPrefixOf, find) -import Control.Monad (forM_) -import System.IO (stderr, hPutStrLn) -import System.Exit (exitFailure) checkmode :: Mode RawOpts checkmode = hledgerCommandMode @@ -53,17 +54,18 @@ cliOptsUpdateReportSpecWith roptsupdate copts@CliOpts{reportspec_} = -- | A type of error check that we can perform on the data. -- Some of these imply other checks that are done first, --- eg currently Parseable and Autobalanced are always done, +-- eg currently Parseable and Balancedwithautoconversion are always done, -- and Assertions are always done unless -I is in effect. data Check = -- done always Parseable - | Autobalanced + | Balancedwithautoconversion -- done always unless -I is used | Assertions -- done when -s is used, or on demand by check | Accounts | Commodities + | Balancednoautoconversion -- done on demand by check | Ordereddates | Payees diff --git a/hledger/Hledger/Cli/Commands/Check.md b/hledger/Hledger/Cli/Commands/Check.md index 0c5354d1b..54341695b 100644 --- a/hledger/Hledger/Cli/Commands/Check.md +++ b/hledger/Hledger/Cli/Commands/Check.md @@ -28,7 +28,7 @@ including `check`: - **parseable** - data files are well-formed and can be [successfully parsed](hledger.html#input-files) -- **autobalanced** - all transactions are [balanced](hledger.html#postings), +- **balancedwithautoconversion** - all transactions are [balanced](hledger.html#postings), inferring missing amounts where necessary, and possibly converting commodities using [transaction prices] or automatically-inferred transaction prices @@ -46,6 +46,9 @@ Or, they can be run by giving their names as arguments to `check`: - **commodities** - all commodity symbols used [have been declared](hledger.html#commodity-error-checking) +- **balancednoautoconversion** - transactions are balanced, possibly using + explicit transaction prices but not [inferred ones](#transaction-prices) + ### Other checks These checks can be run only by giving their names as arguments to `check`. diff --git a/hledger/Hledger/Cli/Commands/Diff.hs b/hledger/Hledger/Cli/Commands/Diff.hs index bc2b8b318..7a9284940 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -87,7 +87,7 @@ matching ppl ppr = do readJournalFile' :: FilePath -> IO Journal readJournalFile' fn = - readJournalFile definputopts {ignore_assertions_ = True} fn >>= either error' return -- PARTIAL: + readJournalFile definputopts{balancingopts_=balancingOpts{ignore_assertions_=True}} fn >>= either error' return -- PARTIAL: matchingPostings :: AccountName -> Journal -> [PostingWithPath] matchingPostings acct j = filter ((== acct) . paccount . ppposting) $ allPostingsWithPath j diff --git a/hledger/Hledger/Cli/Commands/Import.hs b/hledger/Hledger/Cli/Commands/Import.hs index c052573ee..4b1fe1552 100755 --- a/hledger/Hledger/Cli/Commands/Import.hs +++ b/hledger/Hledger/Cli/Commands/Import.hs @@ -33,7 +33,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do inputstr = intercalate ", " $ map quoteIfNeeded inputfiles catchup = boolopt "catchup" rawopts dryrun = boolopt "dry-run" rawopts - iopts' = iopts{new_=True, new_save_=not dryrun, commoditystyles_=Just $ journalCommodityStyles j} + iopts' = iopts{new_=True, new_save_=not dryrun, balancingopts_=balancingOpts{commodity_styles_=Just $ journalCommodityStyles j}} case inputfiles of [] -> error' "please provide one or more input files as arguments" -- PARTIAL: fs -> do diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 404898a9e..74d0f33a2 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -152,9 +152,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = forecasttxns journalBalanceTransactions' iopts j = - let assrt = not . ignore_assertions_ $ iopts - in - either error' id $ journalBalanceTransactions assrt j -- PARTIAL: + either error' id $ journalBalanceTransactions (balancingopts_ iopts) j -- PARTIAL: -- | Write some output to stdout or to a file selected by --output-file. -- If the file exists it will be overwritten. diff --git a/hledger/test/check-balancednoautoconversion.test b/hledger/test/check-balancednoautoconversion.test new file mode 100644 index 000000000..780b8f80e --- /dev/null +++ b/hledger/test/check-balancednoautoconversion.test @@ -0,0 +1,8 @@ +# 1. Check that prices balance without auto-inferring prices +< +2011/01/01 x + a -10£ + b 16$ +$ hledger -f - check balancednoautoconversion +>2 /real postings' sum should be 0 but is: 16\$/ +>=1 diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index 3b525f857..dbbd96f48 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -126,7 +126,16 @@ hledger -f - balance -10£ >>>=0 -# 10. When commodity price is specified implicitly, transaction should +# 10. Should not infer prices when --strict is specified +hledger -f - balance --strict +<<< +2011/01/01 x + a -10£ + b 16$ +>>> +>>>=1 + +# 11. When commodity price is specified implicitly, transaction should # NOT be considered balanced out when BOTH amounts are negative hledger -f - balance <<< @@ -136,7 +145,7 @@ hledger -f - balance >>> >>>=1 -# 11. Differently-priced lots of a commodity should be merged in balance report +# 12. Differently-priced lots of a commodity should be merged in balance report hledger -f - balance <<< 2011/1/1 @@ -150,7 +159,7 @@ hledger -f - balance £2 >>>=0 -# 12. this should balance +# 13. this should balance hledger -f - balance <<< 2011/1/1 @@ -159,7 +168,7 @@ hledger -f - balance c $-30 >>>= 0 -# 13. these balance because of the unit prices, and should parse successfully +# 14. these balance because of the unit prices, and should parse successfully hledger -f - balance --no-total <<< 1/1 @@ -169,7 +178,7 @@ hledger -f - balance --no-total -1X a >>>= 0 -# 14. +# 15. hledger -f - balance --no-total -B <<< 1/1 @@ -178,7 +187,7 @@ hledger -f - balance --no-total -B >>> >>>= 0 -# 15. likewise with total prices. Note how the primary amount's sign is used. +# 16. likewise with total prices. Note how the primary amount's sign is used. hledger -f - balance --no-total <<< 1/1 @@ -188,7 +197,7 @@ hledger -f - balance --no-total -1X a >>>= 0 -# 16. +# 17. hledger -f - balance --no-total -B <<< 1/1 @@ -197,7 +206,7 @@ hledger -f - balance --no-total -B >>> >>>= 0 -# 17. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) +# 18. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) hledger -f - balance --no-total -E <<< 1/1 @@ -210,7 +219,7 @@ hledger -f - balance --no-total -E -1Y b >>>= 0 -# 18. Without -E, a should be hidden because its balance is zero, even though it has a non-zero cost. +# 19. Without -E, a should be hidden because its balance is zero, even though it has a non-zero cost. hledger -f - balance --no-total <<< 1/1 @@ -222,7 +231,7 @@ hledger -f - balance --no-total -1Y b >>>= 0 -# 19. the above with -B +# 20. the above with -B hledger -f - balance --no-total -E -B <<< 1/1