simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-26 20:02:27 +03:00
Code Issues Projects Releases Wiki Activity

lib,cli,ui,web: Add check balancednoautoconversion command, which checks that

Browse Source 
transactions are balanced possibly using explicit prices, but without
inferring any prices. This is included in --strict mode.

Renames check autobalanced to check balancedwithautoconversion.
This commit is contained in:
Stephen Morgan 2021-06-04 22:40:10 +10:00 committed by Simon Michael
parent 68e975adf1
commit 0f1837816d
21 changed files with 141 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
hledger-lib/Hledger/Data/Journal.hs
View File

@ -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

75
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -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
""

46
hledger-lib/Hledger/Read/Common.hs
View File

@ -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

2
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -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

2
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -78,7 +78,7 @@ balanceReport rspec j = (rows, total)
-- tests
Right samplejournal2 =
journalBalanceTransactions False
journalBalanceTransactions balancingOpts
nulljournal{
jtxns = [
txnTieKnot Transaction{

12
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -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 =

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -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

2
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -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

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -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 [

2
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -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 [

4
hledger-ui/Hledger/UI/UIState.hs
View File

@ -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

2
hledger-web/Hledger/Web/Widget/AddForm.hs
View File

@ -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

4
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -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

4
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -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

20
hledger/Hledger/Cli/Commands/Check.hs
View File

@ -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

5
hledger/Hledger/Cli/Commands/Check.md
View File

@ -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`.

2
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -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

2
hledger/Hledger/Cli/Commands/Import.hs
View File

@ -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

4
hledger/Hledger/Cli/Utils.hs
View File

@ -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.

8
hledger/test/check-balancednoautoconversion.test Normal file
View File

@ -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

29
hledger/test/journal/transaction-prices.test
View File

@ -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