From f0ec7b08a3bc58066405b5ba1a6d45c21d9d424f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 4 Jul 2007 01:38:56 +0000 Subject: [PATCH] track amount precision, and use the highest precision found for display; parsing fixes --- Amount.hs | 57 +++++++++++++++++++++++++++------------------ Currency.hs | 10 ++++---- EntryTransaction.hs | 4 +++- Ledger.hs | 14 ++++++++--- NOTES | 12 ++++++---- Parse.hs | 25 ++++++++++++-------- Tests.hs | 53 ++++++++++++++++++++++++++++------------- Transaction.hs | 8 ++++--- Types.hs | 6 +++-- hledger.hs | 2 +- 10 files changed, 123 insertions(+), 68 deletions(-) diff --git a/Amount.hs b/Amount.hs index 91ae65db5..0fdf8535c 100644 --- a/Amount.hs +++ b/Amount.hs @@ -35,26 +35,28 @@ arithmetic: tests = runTestTT $ test [ show (dollars 1) ~?= "$1.00" - , - show (hours 1) ~?= "1h" -- currently h1.00 - , - parseAmount "$1" ~?= dollars 1 -- currently 0 + ,show (hours 1) ~?= "1h" -- currently h1.00 + ,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) = - let rounded = punctuatethousands $ printf "%.2f" qty in - case rounded of - "0.00" -> "0" - "-0.00" -> "0" - otherwise -> (symbol cur) ++ rounded +showAmountRoundedOrZero a@(Amount c _ _) = + let s = showAmountRounded a + noncurrency = drop (length $ symbol c) + nonnulls = filter (flip notElem "-+,.0") + iszero = (nonnulls $ noncurrency s) == "" + 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) - signum (Amount c q) = Amount c (signum q) - fromInteger i = Amount (getcurrency "$") (fromInteger i) - (+) = amountAdd - (-) = amountSub - (*) = amountMul -Amount ac aq `amountAdd` b = Amount ac (aq + (quantity $ toCurrency ac b)) -Amount ac aq `amountSub` b = Amount ac (aq - (quantity $ toCurrency ac b)) -Amount ac aq `amountMul` b = Amount ac (aq * (quantity $ toCurrency ac b)) + abs (Amount c q p) = Amount c (abs q) p + signum (Amount c q p) = Amount c (signum q) p + fromInteger i = Amount (getcurrency "$") (fromInteger i) amtintprecision + (+) = amountop (+) + (-) = amountop (-) + (*) = amountop (*) + +-- problem: when an integer is converted to an amount it must pick a +-- 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) = - Amount newc (q * (conversionRate oldc newc)) +toCurrency newc (Amount oldc q p) = + Amount newc (q * (conversionRate oldc newc)) p + diff --git a/Currency.hs b/Currency.hs index d90ad7f81..bbf5861a1 100644 --- a/Currency.hs +++ b/Currency.hs @@ -19,9 +19,9 @@ conversionRate :: Currency -> Currency -> Double conversionRate oldc newc = (rate newc) / (rate oldc) -- convenient amount constructors -dollars = Amount $ getcurrency "$" -euro = Amount $ getcurrency "EUR" -pounds = Amount $ getcurrency "£" -hours = Amount $ getcurrency "h" -minutes = Amount $ getcurrency "m" +dollars n = Amount (getcurrency "$") n 2 +euro n = Amount (getcurrency "EUR") n 2 +pounds n = Amount (getcurrency "£") n 2 +hours n = Amount (getcurrency "h") n 2 +minutes n = Amount (getcurrency "m") n 2 diff --git a/EntryTransaction.hs b/EntryTransaction.hs index 7f49d5d1d..1247d6319 100644 --- a/EntryTransaction.hs +++ b/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 diff --git a/Ledger.hs b/Ledger.hs index 19a654d90..035bc951c 100644 --- a/Ledger.hs +++ b/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 diff --git a/NOTES b/NOTES index 6b537c9fe..a6d980ee5 100644 --- a/NOTES +++ b/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 diff --git a/Parse.hs b/Parse.hs index b89a52a1f..163908f1d 100644 --- a/Parse.hs +++ b/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 - many1 spacenonewline - currency <- many (noneOf "-.0123456789;\n") "currency" - quantity <- many1 (oneOf "-.,0123456789") "quantity" - return (Amount (getcurrency currency) (read $ stripcommas quantity)) - ) <|> - return (Amount (Currency "AUTO" 0) 0) - -stripcommas = filter (',' /=) +ledgeramount = + try (do + many1 spacenonewline + c <- many (noneOf "-.0123456789;\n") "currency" + q <- many1 (oneOf "-.,0123456789") "quantity" + let q' = stripcommas $ striptrailingpoint q + let (int,frac) = break (=='.') q' + let precision = length $ dropWhile (=='.') frac + return (Amount (getcurrency c) (read q') precision) + ) + <|> 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") diff --git a/Tests.hs b/Tests.hs index c1d575582..6d4a059a9 100644 --- a/Tests.hs +++ b/Tests.hs @@ -75,8 +75,8 @@ entry1_str = "\ entry1 = (Entry "2007/01/28" False "" "coopportunity" - [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18), - Transaction "assets:checking" (Amount (getcurrency "$") (-47.18))]) + [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2), + 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 diff --git a/Transaction.hs b/Transaction.hs index 580da2a5d..e1adaaf29 100644 --- a/Transaction.hs +++ b/Transaction.hs @@ -9,9 +9,11 @@ import Amount instance Show Transaction where show = showTransaction -showTransaction t = (showAccountName $ taccount t) ++ " " ++ (showAmount $ tamount t) -showAmount amt = printf "%11s" (show amt) -showAccountName s = printf "%-22s" (elideRight 22 s) +showTransaction :: Transaction -> String +showTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) + where + showaccountname = printf "%-22s" . elideRight 22 + showamount = printf "%11s" . showAmountRoundedOrZero elideRight width s = case length s > width of diff --git a/Types.hs b/Types.hs index ecddd0a75..75c866f4b 100644 --- a/Types.hs +++ b/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 } diff --git a/hledger.hs b/hledger.hs index 6a2e199c5..a06220a53 100644 --- a/hledger.hs +++ b/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