slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages 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 -- | 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). -- if any of them fail (or if the transaction balancing they require fails).
journalCheckBalanceAssertions :: Journal -> Maybe String journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions def
-- "Transaction balancing", including: inferring missing amounts, -- "Transaction balancing", including: inferring missing amounts,
-- applying balance assignments, checking transaction balancedness, -- 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 -- This does multiple things at once because amount inferring, balance
-- assignments, balance assertions and posting dates are interdependent. -- assignments, balance assertions and posting dates are interdependent.
journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions assrt j' = journalBalanceTransactions bopts' j' =
let let
-- ensure transactions are numbered, so we can store them by number -- ensure transactions are numbered, so we can store them by number
j@Journal{jtxns=ts} = journalNumberTransactions j' j@Journal{jtxns=ts} = journalNumberTransactions j'
-- display precisions used in balanced checking -- display precisions used in balanced checking
styles = Just $ journalCommodityStyles j styles = Just $ journalCommodityStyles j
bopts = bopts'{commodity_styles_=styles}
-- balance assignments will not be allowed on these -- balance assignments will not be allowed on these
txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j
in in
@ -840,7 +841,7 @@ journalBalanceTransactions assrt j' =
-- and leaving the others for later. The balanced ones are split into their postings. -- 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. -- The postings and not-yet-balanced transactions remain in the same relative order.
psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case 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 Left e -> throwError e
Right t' -> do Right t' -> do
lift $ writeArray balancedtxns (tindex t') t' 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, -- 2. Sort these items by date, preserving the order of same-day items,
-- and step through them while keeping running account balances, -- and step through them while keeping running account balances,
runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j) 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, -- performing balance assignments in, and balancing, the remaining transactions,
-- and checking balance assertions as each posting is processed. -- and checking balance assertions as each posting is processed.
void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts
@ -879,7 +880,7 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
ps' <- mapM (addOrAssignAmountAndCheckAssertionB . postingStripPrices) ps ps' <- mapM (addOrAssignAmountAndCheckAssertionB . postingStripPrices) ps
-- infer any remaining missing amounts, and make sure the transaction is now fully balanced -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
styles <- R.reader bsStyles 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 Left err -> throwError err
Right (t', inferredacctsandamts) -> do Right (t', inferredacctsandamts) -> do
-- for each amount just inferred, update the running balance -- for each amount just inferred, update the running balance
@ -1404,7 +1405,7 @@ journalApplyAliases aliases j =
-- liabilities:debts $1 -- liabilities:debts $1
-- assets:bank:checking -- assets:bank:checking
-- --
Right samplejournal = journalBalanceTransactions False $ Right samplejournal = journalBalanceTransactions def $
nulljournal nulljournal
{jtxns = [ {jtxns = [
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
@ -1547,7 +1548,7 @@ tests_Journal = tests "Journal" [
,tests "journalBalanceTransactions" [ ,tests "journalBalanceTransactions" [
test "balance-assignment" $ do test "balance-assignment" $ do
let ej = journalBalanceTransactions True $ let ej = journalBalanceTransactions def $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
nulljournal{ jtxns = [ nulljournal{ jtxns = [
@ -1558,7 +1559,7 @@ tests_Journal = tests "Journal" [
(jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]
,test "same-day-1" $ do ,test "same-day-1" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions def $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
--2019/01/01 --2019/01/01
@ -1569,7 +1570,7 @@ tests_Journal = tests "Journal" [
]} ]}
,test "same-day-2" $ do ,test "same-day-2" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions def $
--2019/01/01 --2019/01/01
-- (a) 2 = 2 -- (a) 2 = 2
--2019/01/01 --2019/01/01
@ -1587,7 +1588,7 @@ tests_Journal = tests "Journal" [
]} ]}
,test "out-of-order" $ do ,test "out-of-order" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions def $
--2019/1/2 --2019/1/2
-- (a) 1 = 2 -- (a) 1 = 2
--2019/1/1 --2019/1/1

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

@ -28,6 +28,8 @@ module Hledger.Data.Transaction (
virtualPostings, virtualPostings,
balancedVirtualPostings, balancedVirtualPostings,
transactionsPostings, transactionsPostings,
BalancingOpts(..),
balancingOpts,
isTransactionBalanced, isTransactionBalanced,
balanceTransaction, balanceTransaction,
balanceTransactionHelper, balanceTransactionHelper,
@ -61,7 +63,7 @@ module Hledger.Data.Transaction (
) )
where where
import Data.Default (def) import Data.Default (Default(..))
import Data.Foldable (asum) import Data.Foldable (asum)
import Data.List (intercalate, partition) import Data.List (intercalate, partition)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
@ -352,6 +354,21 @@ balancedVirtualPostings = filter isBalancedVirtual . tpostings
transactionsPostings :: [Transaction] -> [Posting] transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = concatMap tpostings 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. -- | Check that this transaction would appear balanced to a human when displayed.
-- On success, returns the empty list, otherwise one or more error messages. -- 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 ? -- 3. Does the amounts' sum appear non-zero when displayed ?
-- (using the given display styles if provided) -- (using the given display styles if provided)
-- --
transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String] transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced mstyles t = errs transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
where where
(rps, bvps) = (realPostings t, balancedVirtualPostings t) (rps, bvps) = (realPostings t, balancedVirtualPostings t)
-- check for mixed signs, detecting nonzeros at display precision -- check for mixed signs, detecting nonzeros at display precision
canonicalise = maybe id canonicaliseMixedAmount mstyles canonicalise = maybe id canonicaliseMixedAmount commodity_styles_
signsOk ps = signsOk ps =
case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of
nonzeros | length nonzeros >= 2 nonzeros | length nonzeros >= 2
@ -402,8 +419,8 @@ transactionCheckBalanced mstyles t = errs
| otherwise = "" | otherwise = ""
-- | Legacy form of transactionCheckBalanced. -- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles isTransactionBalanced bopts = null . transactionCheckBalanced bopts
-- | Balance this transaction, ensuring that its postings -- | Balance this transaction, ensuring that its postings
-- (and its balanced virtual postings) sum to 0, -- (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. -- if provided, so that the result agrees with the numbers users can see.
-- --
balanceTransaction :: balanceTransaction ::
Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles BalancingOpts
-> Transaction -> Transaction
-> Either String Transaction -> Either String Transaction
balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles balanceTransaction bopts = fmap fst . balanceTransactionHelper bopts
-- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB;
-- use one of those instead. It also returns a list of accounts -- use one of those instead. It also returns a list of accounts
-- and amounts that were inferred. -- and amounts that were inferred.
balanceTransactionHelper :: balanceTransactionHelper ::
Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles BalancingOpts
-> Transaction -> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)]) -> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper mstyles t = do balanceTransactionHelper bopts t = do
(t', inferredamtsandaccts) <- (t', inferredamtsandaccts) <- inferBalancingAmount (fromMaybe M.empty $ commodity_styles_ bopts) $
inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t if infer_prices_ bopts then inferBalancingPrices t else t
case transactionCheckBalanced mstyles t' of case transactionCheckBalanced bopts t' of
[] -> Right (txnTieKnot t', inferredamtsandaccts) [] -> Right (txnTieKnot t', inferredamtsandaccts)
errs -> Left $ transactionBalanceError t' errs errs -> Left $ transactionBalanceError t' errs
@ -846,8 +863,7 @@ tests_Transaction =
, tests "balanceTransaction" [ , tests "balanceTransaction" [
test "detect unbalanced entry, sign error" $ test "detect unbalanced entry, sign error" $
assertLeft assertLeft
(balanceTransaction (balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -862,8 +878,7 @@ tests_Transaction =
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}])) [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}]))
,test "detect unbalanced entry, multiple missing amounts" $ ,test "detect unbalanced entry, multiple missing amounts" $
assertLeft $ assertLeft $
balanceTransaction balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -880,8 +895,7 @@ tests_Transaction =
]) ])
,test "one missing amount is inferred" $ ,test "one missing amount is inferred" $
(pamount . last . tpostings <$> (pamount . last . tpostings <$>
balanceTransaction balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -897,8 +911,7 @@ tests_Transaction =
Right (mixedAmount $ usd (-1)) Right (mixedAmount $ usd (-1))
,test "conversion price is inferred" $ ,test "conversion price is inferred" $
(pamount . head . tpostings <$> (pamount . head . tpostings <$>
balanceTransaction balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -916,8 +929,7 @@ tests_Transaction =
Right (mixedAmount $ usd 1.35 @@ eur 1) Right (mixedAmount $ usd 1.35 @@ eur 1)
,test "balanceTransaction balances based on cost if there are unit prices" $ ,test "balanceTransaction balances based on cost if there are unit prices" $
assertRight $ assertRight $
balanceTransaction balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -934,8 +946,7 @@ tests_Transaction =
]) ])
,test "balanceTransaction balances based on cost if there are total prices" $ ,test "balanceTransaction balances based on cost if there are total prices" $
assertRight $ assertRight $
balanceTransaction balanceTransaction def
Nothing
(Transaction (Transaction
0 0
"" ""
@ -954,7 +965,7 @@ tests_Transaction =
, tests "isTransactionBalanced" [ , tests "isTransactionBalanced" [
test "detect balanced" $ test "detect balanced" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -972,7 +983,7 @@ tests_Transaction =
,test "detect unbalanced" $ ,test "detect unbalanced" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -990,7 +1001,7 @@ tests_Transaction =
,test "detect unbalanced, one posting" $ ,test "detect unbalanced, one posting" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -1005,7 +1016,7 @@ tests_Transaction =
[posting {paccount = "b", pamount = mixedAmount (usd 1.00)}] [posting {paccount = "b", pamount = mixedAmount (usd 1.00)}]
,test "one zero posting is considered balanced for now" $ ,test "one zero posting is considered balanced for now" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -1020,7 +1031,7 @@ tests_Transaction =
[posting {paccount = "b", pamount = mixedAmount (usd 0)}] [posting {paccount = "b", pamount = mixedAmount (usd 0)}]
,test "virtual postings don't need to balance" $ ,test "virtual postings don't need to balance" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -1039,7 +1050,7 @@ tests_Transaction =
,test "balanced virtual postings need to balance among themselves" $ ,test "balanced virtual postings need to balance among themselves" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""
@ -1057,7 +1068,7 @@ tests_Transaction =
] ]
,test "balanced virtual postings need to balance among themselves (2)" $ ,test "balanced virtual postings need to balance among themselves (2)" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced def $
Transaction Transaction
0 0
"" ""

24
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) ,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV)
,aliases_ :: [String] -- ^ account name aliases to apply ,aliases_ :: [String] -- ^ account name aliases to apply
,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data ,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_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time ,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name ,pivot_ :: String -- ^ use the given field's value as the account name
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
,commoditystyles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ optional commodity display styles affecting all files ,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions
,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared) ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)
} deriving (Show) } deriving (Show)
instance Default InputOpts where def = definputopts instance Default InputOpts where def = definputopts
@ -213,12 +212,11 @@ definputopts = InputOpts
, mrules_file_ = Nothing , mrules_file_ = Nothing
, aliases_ = [] , aliases_ = []
, anon_ = False , anon_ = False
, ignore_assertions_ = False
, new_ = False , new_ = False
, new_save_ = True , new_save_ = True
, pivot_ = "" , pivot_ = ""
, auto_ = False , auto_ = False
, commoditystyles_ = Nothing , balancingopts_ = def
, strict_ = False , strict_ = False
} }
@ -229,14 +227,16 @@ rawOptsToInputOpts rawopts = InputOpts{
,mrules_file_ = maybestringopt "rules-file" rawopts ,mrules_file_ = maybestringopt "rules-file" rawopts
,aliases_ = listofstringopt "alias" rawopts ,aliases_ = listofstringopt "alias" rawopts
,anon_ = boolopt "anon" rawopts ,anon_ = boolopt "anon" rawopts
,ignore_assertions_ = boolopt "ignore-assertions" rawopts
,new_ = boolopt "new" rawopts ,new_ = boolopt "new" rawopts
,new_save_ = True ,new_save_ = True
,pivot_ = stringopt "pivot" rawopts ,pivot_ = stringopt "pivot" rawopts
,auto_ = boolopt "auto" rawopts ,auto_ = boolopt "auto" rawopts
,commoditystyles_ = Nothing ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts
, infer_prices_ = not noinferprice
}
,strict_ = boolopt "strict" rawopts ,strict_ = boolopt "strict" rawopts
} }
where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion"
--- ** parsing utilities --- ** parsing utilities
@ -324,11 +324,11 @@ parseAndFinaliseJournal' parser iopts f txt = do
-- - infer transaction-implied market prices from transaction prices -- - infer transaction-implied market prices from transaction prices
-- --
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal 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 t <- liftIO getClockTime
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
let pj' = 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 & journalAddFile (f, txt) -- save the main file's info
& journalSetLastReadTime t -- save the last read time & journalSetLastReadTime t -- save the last read time
& journalReverse -- convert all lists to the order they were parsed & journalReverse -- convert all lists to the order they were parsed
@ -353,11 +353,11 @@ journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f t
then then
-- Auto postings are not active. -- Auto postings are not active.
-- Balance all transactions and maybe check balance assertions. -- Balance all transactions and maybe check balance assertions.
journalBalanceTransactions (not ignore_assertions_) journalBalanceTransactions balancingopts_
else \j -> do -- Either monad else \j -> do -- Either monad
-- Auto postings are active. -- Auto postings are active.
-- Balance all transactions without checking balance assertions, -- Balance all transactions without checking balance assertions,
j' <- journalBalanceTransactions False j j' <- journalBalanceTransactions balancingopts_{ignore_assertions_=True} j
-- then add the auto postings -- then add the auto postings
-- (Note adding auto postings after balancing means #893b fails; -- (Note adding auto postings after balancing means #893b fails;
-- adding them before balancing probably means #893a, #928, #938 fail.) -- 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 ?) -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?)
j''' <- journalApplyCommodityStyles j'' j''' <- journalApplyCommodityStyles j''
-- then check balance assertions. -- then check balance assertions.
journalBalanceTransactions (not ignore_assertions_) j''' journalBalanceTransactions balancingopts_ j'''
) )
& fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions & 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. -- apply any command line account aliases. Can fail with a bad replacement pattern.
in case journalApplyAliases (aliasesFromOpts iopts) pj' of in case journalApplyAliases (aliasesFromOpts iopts) pj' of
Left e -> throwError e 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 --- ** reading rules files
--- *** rules utilities --- *** rules utilities

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

@ -78,7 +78,7 @@ balanceReport rspec j = (rows, total)
-- tests -- tests
Right samplejournal2 = Right samplejournal2 =
journalBalanceTransactions False journalBalanceTransactions balancingOpts
nulljournal{ nulljournal{
jtxns = [ jtxns = [
txnTieKnot Transaction{ 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 all periodic transactions, calculate actual balance changes
-- from the regular transactions, and compare these to get a 'BudgetReport'. -- from the regular transactions, and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames). -- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames).
budgetReport :: ReportSpec -> Bool -> DateSpan -> Journal -> BudgetReport budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport
budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
where where
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled -- 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 -- 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) $ concatMap (`runPeriodicTransaction` reportspan) $
jperiodictxns j jperiodictxns j
actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j
budgetj = journalAddBudgetGoalTransactions assrt ropts reportspan j budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j
actualreport@(PeriodicReport actualspans _ _) = actualreport@(PeriodicReport actualspans _ _) =
dbg5 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj dbg5 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = 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 -- Budget goal transactions are similar to forecast transactions except
-- their purpose and effect is to define balance change goals, per account and period, -- their purpose and effect is to define balance change goals, per account and period,
-- for BudgetReport. -- for BudgetReport.
journalAddBudgetGoalTransactions :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
journalAddBudgetGoalTransactions assrt _ropts reportspan j = journalAddBudgetGoalTransactions bopts _ropts reportspan j =
either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts } -- PARTIAL: either error' id $ journalBalanceTransactions bopts j{ jtxns = budgetts } -- PARTIAL:
where where
budgetspan = dbg3 "budget span" $ reportspan budgetspan = dbg3 "budget span" $ reportspan
budgetts = 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) <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
<+> borderDepthStr mdepth <+> borderDepthStr mdepth
<+> str (" ("++curidx++"/"++totidx++")") <+> str (" ("++curidx++"/"++totidx++")")
<+> (if ignore_assertions_ $ inputopts_ copts <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
then withAttr ("border" <> "query") (str " ignoring balance assertions") then withAttr ("border" <> "query") (str " ignoring balance assertions")
else str "") else str "")
where 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. -- are disabled, do nothing.
uiCheckBalanceAssertions :: Day -> UIState -> UIState uiCheckBalanceAssertions :: Day -> UIState -> UIState
uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j}
| ignore_assertions_ $ inputopts_ copts = ui | ignore_assertions_ . balancingopts_ $ inputopts_ copts = ui
| otherwise = | otherwise =
case journalCheckBalanceAssertions j of case journalCheckBalanceAssertions j of
Nothing -> ui 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 "/" <+> str "/"
<+> total <+> total
<+> str ")" <+> 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 where
togglefilters = togglefilters =
case concat [ 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 <+> togglefilters
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts) <+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
<+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")") <+> 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 where
togglefilters = togglefilters =
case concat [ 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. -- | Toggle the ignoring of balance assertions.
toggleIgnoreBalanceAssertions :: UIState -> UIState toggleIgnoreBalanceAssertions :: UIState -> UIState
toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} = toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts@InputOpts{balancingopts_=bopts}}}} =
ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{ignore_assertions_=not $ ignore_assertions_ iopts}}}} ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{balancingopts_=bopts{ignore_assertions_=not $ ignore_assertions_ bopts}}}}}
-- | Step through larger report periods, up to all. -- | Step through larger report periods, up to all.
growReportPeriod :: Day -> UIState -> UIState growReportPeriod :: Day -> UIState -> UIState

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

@ -110,7 +110,7 @@ validateTransaction ::
-> FormResult Transaction -> FormResult Transaction
validateTransaction dateRes descRes postingsRes = validateTransaction dateRes descRes postingsRes =
case makeTransaction <$> dateRes <*> descRes <*> postingsRes of 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] Left e -> FormFailure [T.pack e]
Right txn' -> FormSuccess txn' Right txn' -> FormSuccess txn'
x -> x x -> x

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

@ -203,7 +203,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
,tcomment=txnCmnt ,tcomment=txnCmnt
,tpostings=esPostings ,tpostings=esPostings
} }
case balanceTransaction Nothing t of -- imprecise balancing (?) case balanceTransaction balancingOpts t of -- imprecise balancing (?)
Right t' -> Right t' ->
confirmedTransactionWizard prevInput es (EndStage t' : stack) confirmedTransactionWizard prevInput es (EndStage t' : stack)
Left err -> do Left err -> do
@ -292,7 +292,7 @@ descriptionAndCommentWizard PrevInput{..} EntryState{..} = do
return $ Just (desc, comment) return $ Just (desc, comment)
postingsBalanced :: [Posting] -> Bool postingsBalanced :: [Posting] -> Bool
postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps} postingsBalanced ps = isRight $ balanceTransaction balancingOpts nulltransaction{tpostings=ps}
accountWizard PrevInput{..} EntryState{..} = do accountWizard PrevInput{..} EntryState{..} = do
let pnum = length esPostings + 1 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 balance opts@CliOpts{reportspec_=rspec} j = case reporttype_ of
BudgetReport -> do -- single or multi period budget report BudgetReport -> do -- single or multi period budget report
let reportspan = reportSpan j rspec let reportspan = reportSpan j rspec
budgetreport = budgetReport rspec assrt reportspan j budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) reportspan j
where
assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of render = case fmt of
"txt" -> budgetReportAsText ropts "txt" -> budgetReportAsText ropts
"json" -> (<>"\n") . toJsonText "json" -> (<>"\n") . toJsonText

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

@ -9,17 +9,18 @@ module Hledger.Cli.Commands.Check (
,check ,check
) where ) 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates) import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates)
import Hledger.Cli.Commands.Check.Uniqueleafnames (journalCheckUniqueleafnames) 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 :: Mode RawOpts
checkmode = hledgerCommandMode checkmode = hledgerCommandMode
@ -53,17 +54,18 @@ cliOptsUpdateReportSpecWith roptsupdate copts@CliOpts{reportspec_} =
-- | A type of error check that we can perform on the data. -- | A type of error check that we can perform on the data.
-- Some of these imply other checks that are done first, -- 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. -- and Assertions are always done unless -I is in effect.
data Check = data Check =
-- done always -- done always
Parseable Parseable
| Autobalanced | Balancedwithautoconversion
-- done always unless -I is used -- done always unless -I is used
| Assertions | Assertions
-- done when -s is used, or on demand by check -- done when -s is used, or on demand by check
| Accounts | Accounts
| Commodities | Commodities
| Balancednoautoconversion
-- done on demand by check -- done on demand by check
| Ordereddates | Ordereddates
| Payees | 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 - **parseable** - data files are well-formed and can be
[successfully parsed](hledger.html#input-files) [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 inferring missing amounts where necessary, and possibly converting commodities
using [transaction prices] or automatically-inferred transaction prices 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 - **commodities** - all commodity symbols used
[have been declared](hledger.html#commodity-error-checking) [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 ### Other checks
These checks can be run only by giving their names as arguments to `check`. 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' :: FilePath -> IO Journal
readJournalFile' fn = 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 :: AccountName -> Journal -> [PostingWithPath]
matchingPostings acct j = filter ((== acct) . paccount . ppposting) $ allPostingsWithPath j 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 inputstr = intercalate ", " $ map quoteIfNeeded inputfiles
catchup = boolopt "catchup" rawopts catchup = boolopt "catchup" rawopts
dryrun = boolopt "dry-run" 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 case inputfiles of
[] -> error' "please provide one or more input files as arguments" -- PARTIAL: [] -> error' "please provide one or more input files as arguments" -- PARTIAL:
fs -> do fs -> do

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

@ -152,9 +152,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
forecasttxns forecasttxns
journalBalanceTransactions' iopts j = journalBalanceTransactions' iopts j =
let assrt = not . ignore_assertions_ $ iopts either error' id $ journalBalanceTransactions (balancingopts_ iopts) j -- PARTIAL:
in
either error' id $ journalBalanceTransactions assrt j -- PARTIAL:
-- | Write some output to stdout or to a file selected by --output-file. -- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. -- 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£ -10£
>>>=0 >>>=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 # NOT be considered balanced out when BOTH amounts are negative
hledger -f - balance hledger -f - balance
<<< <<<
@ -136,7 +145,7 @@ hledger -f - balance
>>> >>>
>>>=1 >>>=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 hledger -f - balance
<<< <<<
2011/1/1 2011/1/1
@ -150,7 +159,7 @@ hledger -f - balance
£2 £2
>>>=0 >>>=0
# 12. this should balance # 13. this should balance
hledger -f - balance hledger -f - balance
<<< <<<
2011/1/1 2011/1/1
@ -159,7 +168,7 @@ hledger -f - balance
c $-30 c $-30
>>>= 0 >>>= 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 hledger -f - balance --no-total
<<< <<<
1/1 1/1
@ -169,7 +178,7 @@ hledger -f - balance --no-total
-1X a -1X a
>>>= 0 >>>= 0
# 14. # 15.
hledger -f - balance --no-total -B hledger -f - balance --no-total -B
<<< <<<
1/1 1/1
@ -178,7 +187,7 @@ hledger -f - balance --no-total -B
>>> >>>
>>>= 0 >>>= 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 hledger -f - balance --no-total
<<< <<<
1/1 1/1
@ -188,7 +197,7 @@ hledger -f - balance --no-total
-1X a -1X a
>>>= 0 >>>= 0
# 16. # 17.
hledger -f - balance --no-total -B hledger -f - balance --no-total -B
<<< <<<
1/1 1/1
@ -197,7 +206,7 @@ hledger -f - balance --no-total -B
>>> >>>
>>>= 0 >>>= 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 hledger -f - balance --no-total -E
<<< <<<
1/1 1/1
@ -210,7 +219,7 @@ hledger -f - balance --no-total -E
-1Y b -1Y b
>>>= 0 >>>= 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 hledger -f - balance --no-total
<<< <<<
1/1 1/1
@ -222,7 +231,7 @@ hledger -f - balance --no-total
-1Y b -1Y b
>>>= 0 >>>= 0
# 19. the above with -B # 20. the above with -B
hledger -f - balance --no-total -E -B hledger -f - balance --no-total -E -B
<<< <<<
1/1 1/1