From 811e71aba71a7989d947483f7e3bd40075f6f376 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 14 Nov 2010 22:44:37 +0000 Subject: [PATCH] price precisions don't influence display precision; balancing is based on display precision (#23) Like ledger, price amounts are now "unobserved", ie their precision does not affect the canonical display precisions used when displaying amounts, and transaction balancing is done based on display precision, ie amounts are considered to balance if their sum appears to be zero when using the canonical display precision. --- hledger-lib/Hledger/Data/Amount.hs | 8 +++-- hledger-lib/Hledger/Data/Journal.hs | 17 +++++++++-- hledger-lib/Hledger/Data/Transaction.hs | 35 ++++++++++++++++------ hledger-lib/Hledger/Read/JournalReader.hs | 8 +++-- hledger-lib/Hledger/Read/Utils.hs | 8 +++-- hledger-web/Hledger/Web/App.hs | 2 +- hledger/Hledger/Cli/Add.hs | 2 +- hledger/Hledger/Cli/Tests.hs | 20 ++++++------- tests/commodityless-amount-with-price.test | 2 +- tests/precision.test | 33 ++++++++++++++++++++ 10 files changed, 103 insertions(+), 32 deletions(-) create mode 100644 tests/precision.test diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index f1a0f5d58..016eac5b0 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -110,7 +110,7 @@ showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = R -> printf "%s%s%s%s" quantity space sym' price where sym' = quoteCommoditySymbolIfNeeded sym - space = if spaced then " " else "" + space = if (spaced && not (null sym')) then " " else "" quantity = showAmount' a price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt Nothing -> "" @@ -132,6 +132,10 @@ showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{price=Nothing} +-- | Get the string representation of an amount, without any price or commodity symbol. +showAmountWithoutPriceOrCommodity :: Amount -> String +showAmountWithoutPriceOrCommodity a@Amount{commodity=c} = showAmount a{commodity=c{symbol=""}, price=Nothing} + -- | Get the string representation of the number part of of an amount, -- using the display precision from its commodity. showAmount' :: Amount -> String @@ -158,7 +162,7 @@ punctuatethousands s = -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool -isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPrice +isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity -- | Is this amount "really" zero, regardless of the display precision ? -- Since we are using floating point, for now just test to some high precision. diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 2839463b4..8c14ea1e9 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -18,7 +18,7 @@ import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Commodity (canonicaliseCommodities) import Hledger.Data.Dates (nulldatespan) -import Hledger.Data.Transaction (journalTransactionWithDate) +import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction) import Hledger.Data.Posting import Hledger.Data.TimeLog @@ -225,13 +225,24 @@ journalSelectingDate EffectiveDate j = j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j} -- | Do post-parse processing on a journal, to make it ready for use. -journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Journal +journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} = + journalBalanceTransactions $ journalCanonicaliseAmounts $ journalApplyHistoricalPrices $ journalCloseTimeLogEntries tlocal j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx} +-- | Fill in any missing amounts and check that all journal transactions +-- balance, or return an error message. This is done after parsing all +-- amounts and working out the canonical commodities, since balancing +-- depends on display precision. Reports only the first error encountered. +journalBalanceTransactions :: Journal -> Either String Journal +journalBalanceTransactions j@Journal{jtxns=ts} = + case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'} + Left e -> Left e + where balance = balanceTransaction (Just $ journalCanonicalCommodities j) + -- | Convert all the journal's amounts to their canonical display -- settings. Ie, all amounts in a given commodity will use (a) the -- display settings of the first, and (b) the greatest precision, of the @@ -283,7 +294,7 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. journalCanonicalCommodities :: Journal -> Map.Map String Commodity -journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountAndPriceCommodities j +journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j -- | Get all this journal's amounts' commodities, in the order parsed. journalAmountCommodities :: Journal -> [Commodity] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 710de93a9..6267f6eaa 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -8,6 +8,9 @@ plus a date and optional metadata like description and cleared status. module Hledger.Data.Transaction where +import qualified Data.Map as Map +import Data.Map (findWithDefault) + import Hledger.Data.Utils import Hledger.Data.Types import Hledger.Data.Dates @@ -75,7 +78,7 @@ showTransaction' elide effective t = showdate = printf "%-10s" . showDate showedate = printf "=%s" . showdate showpostings ps - | elide && length ps > 1 && isTransactionBalanced t + | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check = map showposting (init ps) ++ [showpostingnoamt (last ps)] | otherwise = map showposting ps where @@ -122,20 +125,34 @@ transactionPostingBalances t = (sumPostings $ realPostings t -- | Is this transaction balanced ? A balanced transaction's real -- (non-virtual) postings sum to 0, and any balanced virtual postings -- also sum to 0. -isTransactionBalanced :: Transaction -> Bool -isTransactionBalanced t = isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum - where (rsum, _, bvsum) = transactionPostingBalances t +isTransactionBalanced :: Maybe (Map.Map String Commodity) -> Transaction -> Bool +isTransactionBalanced canonicalcommoditymap t = + -- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum + isZeroMixedAmount rsum' && isZeroMixedAmount bvsum' + where + (rsum, _, bvsum) = transactionPostingBalances t + rsum' = canonicaliseMixedAmount canonicalcommoditymap $ costOfMixedAmount rsum + bvsum' = canonicaliseMixedAmount canonicalcommoditymap $ costOfMixedAmount bvsum + +canonicaliseMixedAmount :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount +canonicaliseMixedAmount Nothing = id +canonicaliseMixedAmount (Just canonicalcommoditymap) = fixmixedamount + where + -- like journalCanonicaliseAmounts + fixmixedamount (Mixed as) = Mixed $ map fixamount as + fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c} + fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap -- | Ensure that this entry is balanced, possibly auto-filling a missing -- amount first. We can auto-fill if there is just one non-virtual -- transaction without an amount. The auto-filled balance will be -- converted to cost basis if possible. If the entry can not be balanced, -- return an error message instead. -balanceTransaction :: Transaction -> Either String Transaction -balanceTransaction t@Transaction{tpostings=ps} +balanceTransaction :: Maybe (Map.Map String Commodity) -> Transaction -> Either String Transaction +balanceTransaction canonicalcommoditymap t@Transaction{tpostings=ps} | length rwithoutamounts > 1 || length bvwithoutamounts > 1 = Left $ printerr "could not balance this transaction (too many missing amounts)" - | not $ isTransactionBalanced t' = Left $ printerr $ nonzerobalanceerror t' + | not $ isTransactionBalanced canonicalcommoditymap t' = Left $ printerr $ nonzerobalanceerror t' | otherwise = Right t' where rps = filter isReal ps @@ -145,9 +162,9 @@ balanceTransaction t@Transaction{tpostings=ps} t' = t{tpostings=map balance ps} where balance p | not (hasAmount p) && isReal p - = p{pamount = costOfMixedAmount (-(sum $ map pamount rwithamounts))} + = p{pamount = (-(sum $ map pamount rwithamounts))} | not (hasAmount p) && isBalancedVirtual p - = p{pamount = costOfMixedAmount (-(sum $ map pamount bvwithamounts))} + = p{pamount = (-(sum $ map pamount bvwithamounts))} | otherwise = p printerr s = intercalate "\n" [s, showTransactionUnelided t] diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 1689f9b32..2fd3aa73a 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -332,9 +332,11 @@ ledgerTransaction = do md <- try ledgermetadata <|> return [] postings <- ledgerpostings let t = txnTieKnot $ Transaction date edate status code description comment md postings "" - case balanceTransaction t of - Right t' -> return t' - Left err -> fail err + -- case balanceTransaction Nothing t of + -- Right t' -> return t' + -- Left err -> fail err + -- check it later, after we have worked out commodity display precisions + return t ledgerdate :: GenParser Char JournalContext Day ledgerdate = do diff --git a/hledger-lib/Hledger/Read/Utils.hs b/hledger-lib/Hledger/Read/Utils.hs index a8dc67d30..ddcb76c3f 100644 --- a/hledger-lib/Hledger/Read/Utils.hs +++ b/hledger-lib/Hledger/Read/Utils.hs @@ -26,8 +26,12 @@ parseJournalWith p f s = do tc <- liftIO getClockTime tl <- liftIO getCurrentLocalTime case runParser p nullctx f s of - Right (updates,ctx) -> liftM (journalFinalise tc tl f s ctx) $ updates `ap` return nulljournal - Left err -> throwError $ show err + Right (updates,ctx) -> do + j <- updates `ap` return nulljournal + case journalFinalise tc tl f s ctx j of + Right j' -> return j' + Left estr -> throwError estr + Left e -> throwError $ show e setYear :: Integer -> GenParser tok JournalContext () setYear y = updateState (\ctx -> ctx{ctxYear=Just y}) diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index 5ee7a999b..e6fdae4db 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -881,7 +881,7 @@ postAddForm = do -- if no errors so far, generate a transaction and balance it or get the error. tE | not $ null errs = Left errs | otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right - (balanceTransaction $ nulltransaction { + (balanceTransaction Nothing $ nulltransaction { -- imprecise balancing tdate=parsedate date ,tdescription=desc ,tpostings=[ diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index cdb2d0930..fd16ca750 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -87,7 +87,7 @@ getTransaction j opts args defaultDate = do retry msg = do liftIO $ hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter." getpostingsandvalidate - either retry (return . flip (,) date) $ balanceTransaction t + either retry (return . flip (,) date) $ balanceTransaction Nothing t -- imprecise balancing unless (null historymatches) (liftIO $ do hPutStrLn stderr "Similar transactions found, using the first for defaults:\n" diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index 34e65d8a7..0b1651ff7 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -271,18 +271,18 @@ tests = TestList [ ,"balanceTransaction" ~: do assertBool "detect unbalanced entry, sign error" - (isLeft $ balanceTransaction + (isLeft $ balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing ] "")) assertBool "detect unbalanced entry, multiple missing amounts" - (isLeft $ balanceTransaction + (isLeft $ balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] [Posting False "a" missingamt "" RegularPosting [] Nothing, Posting False "b" missingamt "" RegularPosting [] Nothing ] "")) - let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] + let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, Posting False "b" missingamt "" RegularPosting [] Nothing ] "") @@ -343,39 +343,39 @@ tests = TestList [ [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) ] "" - assertBool "detect balanced" (isTransactionBalanced t) + assertBool "detect balanced" (isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting [] (Just t) ] "" - assertBool "detect unbalanced" (not $ isTransactionBalanced t) + assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ] "" - assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced t) + assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 0]) "" RegularPosting [] (Just t) ] "" - assertBool "one zero posting is considered balanced for now" (isTransactionBalanced t) + assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting [] (Just t) ] "" - assertBool "virtual postings don't need to balance" (isTransactionBalanced t) + assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t) ] "" - assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced t) + assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t) let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t) ,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting [] (Just t) ] "" - assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced t) + assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t) ,"isSubAccountNameOf" ~: do "assets" `isSubAccountNameOf` "assets" `is` False diff --git a/tests/commodityless-amount-with-price.test b/tests/commodityless-amount-with-price.test index d11a265dc..000fd7dbf 100644 --- a/tests/commodityless-amount-with-price.test +++ b/tests/commodityless-amount-with-price.test @@ -8,5 +8,5 @@ bin/hledger -f - print >>> 2010/01/01 x a 1 @ $2 - b $-2 + b -1 @ $2 diff --git a/tests/precision.test b/tests/precision.test new file mode 100644 index 000000000..98fa55899 --- /dev/null +++ b/tests/precision.test @@ -0,0 +1,33 @@ +# http://code.google.com/p/hledger/issues/detail?id=23 +# +# with explicit price: +# prices' commodities are unobserved, so $'s display precision here should be 2 not 4 +bin/hledger -f - print --cost +<<< +2010/1/1 + a $0.00 + a 1C @ $1.0049 + a +>>> +2010/01/01 + a 0 + a $1.00 + a $-1.00 + +>>>2 +# with $'s display precision at 3 or more, this txn should not balance +bin/hledger -f - balance --no-total --cost --empty +<<< +2010/1/1 + a 1C @ $1.0049 + a $-1.000 +>>>2 /off by \$0.005/ +>>>= 1 +# with $'s display precision at 2 or less, this txn should balance +bin/hledger -f - balance --no-total --cost --empty +<<< +2010/1/1 + a 1C @ $1.0049 + a $-1.00 +>>> + $0.00 a