slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

price precisions don't influence display precision; balancing is based on display precision (#23)

Browse Source 
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.
This commit is contained in:
Simon Michael 2010-11-14 22:44:37 +00:00
parent 1551a6914b
commit 811e71aba7
10 changed files with 103 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hledger-lib/Hledger/Data/Amount.hs
View File

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

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

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

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

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

8
hledger-lib/Hledger/Read/JournalReader.hs
View File

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

8
hledger-lib/Hledger/Read/Utils.hs
View File

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

2
hledger-web/Hledger/Web/App.hs
View File

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

2
hledger/Hledger/Cli/Add.hs
View File

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

20
hledger/Hledger/Cli/Tests.hs
View File

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

2
tests/commodityless-amount-with-price.test
View File

@ -8,5 +8,5 @@ bin/hledger -f - print
>>>
2010/01/01 x
a 1 @ $2
b $-2
b -1 @ $2

33
tests/precision.test Normal file
View File

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