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

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

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]

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 :: Maybe (Map.Map String Commodity) -> Transaction -> Bool
-isTransactionBalanced t = isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum
+isTransactionBalanced canonicalcommoditymap t =
-    where (rsum, _, bvsum) = transactionPostingBalances 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 :: Maybe (Map.Map String Commodity) -> Transaction -> Either String Transaction
-balanceTransaction t@Transaction{tpostings=ps}
+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]
 

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
+  -- case balanceTransaction Nothing t of
-    Right t' -> return t'
+  --   Right t' -> return t'
-    Left err -> fail err
+  --   Left err -> fail err
+  -- check it later, after we have worked out commodity display precisions
+  return t
 
 ledgerdate :: GenParser Char JournalContext Day
 ledgerdate = do

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
+    Right (updates,ctx) -> do
-    Left err      -> throwError $ show err
+                           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})

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

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"

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

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
 

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