track amount precision, and use the highest precision found for display; parsing fixes

Amount.hs

@@ -35,26 +35,28 @@ arithmetic:
 
 tests = runTestTT $ test [
          show (dollars 1)   ~?= "$1.00"
-        ,
+        ,show (hours 1)     ~?= "1h"      -- currently h1.00
-         show (hours 1)     ~?= "1h"      -- currently h1.00
+        ,parseAmount "$1"   ~?= dollars 1 -- currently 0
-        ,
-         parseAmount "$1"   ~?= dollars 1 -- currently 0
         ]
 
-instance Show Amount where show = showAmountRoundedOrZero
-
 nullamt = dollars 0
 
 parseAmount :: String -> Amount
 parseAmount s = nullamt
 
+instance Show Amount where show = showAmountRounded
+
+showAmountRounded :: Amount -> String
+showAmountRounded (Amount c q p) =
+    (symbol c) ++ (punctuatethousands $ printf ("%."++show p++"f") q)
+
 showAmountRoundedOrZero :: Amount -> String
-showAmountRoundedOrZero (Amount cur qty) =
+showAmountRoundedOrZero a@(Amount c _ _) =
-    let rounded = punctuatethousands $ printf "%.2f" qty in
+    let s = showAmountRounded a
-    case rounded of
+        noncurrency = drop (length $ symbol c)
-      "0.00"    -> "0"
+        nonnulls = filter (flip notElem "-+,.0")
-      "-0.00"   -> "0"
+        iszero = (nonnulls $ noncurrency s) == ""
-      otherwise -> (symbol cur) ++ rounded
+    in if iszero then "0" else s
 
 punctuatethousands :: String -> String
 punctuatethousands s =
@@ -67,17 +69,26 @@ punctuatethousands s =
       triples s = [take 3 s] ++ (triples $ drop 3 s)
 
 instance Num Amount where
-    abs (Amount c q) = Amount c (abs q)
+    abs (Amount c q p) = Amount c (abs q) p
-    signum (Amount c q) = Amount c (signum q)
+    signum (Amount c q p) = Amount c (signum q) p
-    fromInteger i = Amount (getcurrency "$") (fromInteger i)
+    fromInteger i = Amount (getcurrency "$") (fromInteger i) amtintprecision
-    (+) = amountAdd
+    (+) = amountop (+)
-    (-) = amountSub
+    (-) = amountop (-)
-    (*) = amountMul
+    (*) = amountop (*)
-Amount ac aq `amountAdd` b = Amount ac (aq + (quantity $ toCurrency ac b))
+
-Amount ac aq `amountSub` b = Amount ac (aq - (quantity $ toCurrency ac b))
+-- problem: when an integer is converted to an amount it must pick a
-Amount ac aq `amountMul` b = Amount ac (aq * (quantity $ toCurrency ac b))
+-- precision, which we specify here (should be infinite ?). This can
+-- affect amount arithmetic, in particular the sum of a list of amounts.
+-- So, we may need to adjust the precision after summing amounts.
+amtintprecision = 2
+
+-- apply op to two amounts, adopting a's currency and lowest precision
+amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
+amountop op (Amount ac aq ap) b@(Amount _ _ bp) = 
+    Amount ac (aq `op` (quantity $ toCurrency ac b)) (min ap bp)
 
 toCurrency :: Currency -> Amount -> Amount
-toCurrency newc (Amount oldc q) =
+toCurrency newc (Amount oldc q p) =
-    Amount newc (q * (conversionRate oldc newc))
+    Amount newc (q * (conversionRate oldc newc)) p
+
 

Currency.hs

@@ -19,9 +19,9 @@ conversionRate :: Currency -> Currency -> Double
 conversionRate oldc newc = (rate newc) / (rate oldc)
 
 -- convenient amount constructors
-dollars = Amount $ getcurrency "$"
+dollars n = Amount (getcurrency "$") n 2
-euro    = Amount $ getcurrency "EUR"
+euro    n = Amount (getcurrency "EUR") n 2
-pounds  = Amount $ getcurrency "£"
+pounds  n = Amount (getcurrency "£") n 2
-hours   = Amount $ getcurrency "h"
+hours   n = Amount (getcurrency "h") n 2
-minutes = Amount $ getcurrency "m"
+minutes n = Amount (getcurrency "m") n 2
 

EntryTransaction.hs

@@ -1,4 +1,3 @@
-
 module EntryTransaction
 where
 import Utils
@@ -22,6 +21,9 @@ amount      (e,t) = tamount t
 flattenEntry :: Entry -> [EntryTransaction]
 flattenEntry e = [(e,t) | t <- etransactions e]
 
+entryTransactionSetPrecision :: Int -> EntryTransaction -> EntryTransaction
+entryTransactionSetPrecision p (e, Transaction a amt) = (e, Transaction a amt{precision=p})
+
 accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
 accountNamesFromTransactions ts = nub $ map account ts
 

Ledger.hs

@@ -33,12 +33,13 @@ cacheLedger l =
         txns a = tmap ! a
         subaccts a = filter (isAccountNamePrefixOf a) ans
         subtxns a = concat [txns a | a <- [a] ++ subaccts a]
+        lprecision = maximum $ map (precision . tamount . transaction) ts
         bmap = Map.union 
-               (Map.fromList [(a, sumEntryTransactions $ subtxns a) | a <- ans])
+               (Map.fromList [(a, (sumEntryTransactions $ subtxns a){precision=lprecision}) | a <- ans])
                (Map.fromList [(a,nullamt) | a <- ans])
         amap = Map.fromList [(a, Account a (tmap ! a) (bmap ! a)) | a <- ans]
     in
-      Ledger l ant amap
+      Ledger l ant amap lprecision
 
 accountnames :: Ledger -> [AccountName]
 accountnames l = flatten $ accountnametree l
@@ -46,8 +47,15 @@ accountnames l = flatten $ accountnametree l
 ledgerAccount :: Ledger -> AccountName -> Account
 ledgerAccount l a = (accounts l) ! a
 
+-- This sets all amount precisions to that of the highest-precision
+-- amount, to help with report output. It should perhaps be done in the
+-- display functions, but those are far removed from the ledger. Keep in
+-- mind if doing more arithmetic with these.
 ledgerTransactions :: Ledger -> [EntryTransaction]
-ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
+ledgerTransactions l = 
+    setprecisions $ rawLedgerTransactions $ rawledger l
+    where
+      setprecisions = map (entryTransactionSetPrecision (lprecision l))
 
 ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
 ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l

NOTES

@@ -2,10 +2,11 @@ hledger project notes
 
 * TO DO
 ** bugs
+*** unclear parse error when only one space before amount
+    unexpected "$"
+    expecting letter or digit, ":", "/", "_", amount, comment or new-line
+*** handle unknown currencies
 ** compatibility
-*** use greatest precision in register
-*** abbreviate 0
-*** don't combine entries so much in register
 ** basic features
 *** print
 *** !include
@@ -13,7 +14,7 @@ hledger project notes
 
 ** advanced features
 *** handle mixed amounts
-*** 3.0-style elision
+*** ledger 3.0-style elision
 *** -p period expressions
 *** -d display expressions
 *** read gnucash files
@@ -48,6 +49,9 @@ hledger project notes
 ** documentation
 *** literate docs
 *** better use of haddock
+*** differences
+**** ledger shows comments after descriptions as part of description
+**** ledger does not sort register by date
 ** marketing
 *** set up as a cabal/hackage project following wiki howto 
      http://en.wikibooks.org/wiki/Haskell/Packaging

Parse.hs

@@ -222,18 +222,23 @@ ledgeraccount :: Parser String
 ledgeraccount = many1 (alphaNum <|> char ':' <|> char '/' <|> char '_' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}}))
 
 ledgeramount :: Parser Amount
-ledgeramount = try (do
+ledgeramount = 
+    try (do
           many1 spacenonewline
-                      currency <- many (noneOf "-.0123456789;\n") <?> "currency"
+          c <- many (noneOf "-.0123456789;\n") <?> "currency"
-                      quantity <- many1 (oneOf "-.,0123456789") <?> "quantity"
+          q <- many1 (oneOf "-.,0123456789") <?> "quantity"
-                      return (Amount (getcurrency currency) (read $ stripcommas quantity))
+          let q' = stripcommas $ striptrailingpoint q
-                   ) <|> 
+          let (int,frac) = break (=='.') q'
-                    return (Amount (Currency "AUTO" 0) 0)
+          let precision = length $ dropWhile (=='.') frac
-
+          return (Amount (getcurrency c) (read q') precision)
-stripcommas = filter (',' /=)
+        ) 
+    <|> return (Amount (Currency "AUTO" 0) 0 0)
+    where 
+      stripcommas = filter (',' /=)
+      striptrailingpoint = reverse . dropWhile (=='.') . reverse
 
 ledgereol :: Parser String
-ledgereol = ledgercomment <|> do {newline; return []}  -- XXX problem, a transaction comment containing a digit fails
+ledgereol = ledgercomment <|> do {newline; return []}
 
 spacenonewline :: Parser Char
 spacenonewline = satisfy (\c -> c `elem` " \v\f\t")

Tests.hs

@@ -75,8 +75,8 @@ entry1_str = "\
 
 entry1 =
     (Entry "2007/01/28" False "" "coopportunity" 
-               [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18), 
+               [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2), 
-                Transaction "assets:checking" (Amount (getcurrency "$") (-47.18))])
+                Transaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)])
 
 entry2_str = "\
 \2007/01/27 * joes diner\n\
@@ -214,9 +214,9 @@ ledger7 = RawLedger
                   edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance",
                   etransactions=[
                                 Transaction {taccount="assets:cash", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=4.82}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}},
                                 Transaction {taccount="equity:opening balances", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}}
                                ]
                  }
           ,
@@ -224,9 +224,9 @@ ledger7 = RawLedger
                   edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites",
                   etransactions=[
                                 Transaction {taccount="expenses:vacation", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=179.92}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2}},
                                 Transaction {taccount="assets:checking", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}}
                                ]
                  }
           ,
@@ -234,9 +234,9 @@ ledger7 = RawLedger
                   edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings",
                   etransactions=[
                                 Transaction {taccount="assets:saving", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=200}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}},
                                 Transaction {taccount="assets:checking", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-200)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}}
                                ]
                  }
           ,
@@ -244,9 +244,9 @@ ledger7 = RawLedger
                   edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas",
                   etransactions=[
                                 Transaction {taccount="expenses:food:dining", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=4.82}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}},
                                 Transaction {taccount="assets:cash", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}}
                                ]
                  }
           ,
@@ -254,9 +254,9 @@ ledger7 = RawLedger
                   edate="2007/01/03", estatus=False, ecode="*", edescription="verizon",
                   etransactions=[
                                 Transaction {taccount="expenses:phone", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=95.11}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2}},
                                 Transaction {taccount="assets:checking", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}}
                                ]
                  }
           ,
@@ -264,9 +264,9 @@ ledger7 = RawLedger
                   edate="2007/01/03", estatus=False, ecode="*", edescription="discover",
                   etransactions=[
                                 Transaction {taccount="liabilities:credit cards:discover", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=80}},
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}},
                                 Transaction {taccount="assets:checking", 
-                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-80)}}
+                                             tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}}
                                ]
                  }
           ]
@@ -313,9 +313,30 @@ hunit = runTestTT $ "hunit" ~: test ([
         ,"" ~: test_ledgerAccountNames
         ,"" ~: test_cacheLedger
         ,"" ~: test_showLedgerAccounts
+        ,"" ~: test_Amount
         ] :: [Test])
 
-test_ledgertransaction :: Assertion
+test_ledgeramount :: Assertion
+test_ledgeramount = do
+  assertParseEqual (Amount (getcurrency "$") 47.18 2)
+                   (parse' ledgeramount " $47.18")
+  assertParseEqual (Amount (getcurrency "$") 1 0) 
+                   (parse' ledgeramount " $1.")
+
+test_Amount = do
+  -- precision subtleties
+  let a1 = Amount (getcurrency "$") 1.23 1
+  let a2 = Amount (getcurrency "$") (-1.23) 2
+  let a3 = Amount (getcurrency "$") (-1.23) 3
+  assertEqual "1" (Amount (getcurrency "$") 0 1) (a1 + a2)
+  assertEqual "2" (Amount (getcurrency "$") 0 1) (a1 + a3)
+  assertEqual "3" (Amount (getcurrency "$") (-2.46) 2) (a2 + a3)
+  assertEqual "4" (Amount (getcurrency "$") (-2.46) 3) (a3 + a3)
+  -- sum adds 0, with Amount fromIntegral's default precision of 2
+  assertEqual "5" (Amount (getcurrency "$") 0 1) (sum [a1,a2])
+  assertEqual "6" (Amount (getcurrency "$") (-2.46) 2) (sum [a2,a3])
+  assertEqual "7" (Amount (getcurrency "$") (-2.46) 2) (sum [a3,a3])
+               
 test_ledgertransaction =
     assertParseEqual transaction1 (parse' ledgertransaction transaction1_str)      
 
@@ -324,7 +345,7 @@ test_ledgerentry =
 
 test_autofillEntry = 
     assertEqual'
-    (Amount (getcurrency "$") (-47.18))
+    (Amount (getcurrency "$") (-47.18) 2)
     (tamount $ last $ etransactions $ autofillEntry entry1)
 
 test_timelogentry = do

Transaction.hs

@@ -9,9 +9,11 @@ import Amount
 
 instance Show Transaction where show = showTransaction
 
-showTransaction t = (showAccountName $ taccount t) ++ "  " ++ (showAmount $ tamount t) 
+showTransaction :: Transaction -> String
-showAmount amt = printf "%11s" (show amt)
+showTransaction t = (showaccountname $ taccount t) ++ "  " ++ (showamount $ tamount t) 
-showAccountName s = printf "%-22s" (elideRight 22 s)
+    where
+      showaccountname = printf "%-22s" . elideRight 22
+      showamount = printf "%11s" . showAmountRoundedOrZero
 
 elideRight width s =
     case length s > width of

Types.hs

@@ -43,7 +43,8 @@ data Currency = Currency {
 -- some amount of money, time, stock, oranges, etc.
 data Amount = Amount {
       currency :: Currency,
-      quantity :: Double
+      quantity :: Double,
+      precision :: Int -- number of significant decimal places
     } deriving (Eq)
 
 -- AccountNames are strings like "assets:cash:petty"; from these we build
@@ -115,6 +116,7 @@ data Account = Account {
 data Ledger = Ledger {
       rawledger :: RawLedger, 
       accountnametree :: Tree AccountName,
-      accounts :: Map.Map AccountName Account
+      accounts :: Map.Map AccountName Account,
+      lprecision :: Int
     }
 

hledger.hs

@@ -46,7 +46,7 @@ register opts acctpats descpats = do
       printRegister l = 
           putStr $ showTransactionsWithBalances 
                      (sortBy (comparing date) (ledgerTransactionsMatching (acctpats,descpats) l))
-                     0
+                     nullamt{precision=lprecision l}
 
 balance :: [Flag] -> [String] -> [String] -> IO ()
 balance opts acctpats _ = do