diff --git a/Ledger.hs b/Ledger.hs index 669732ee6..151579b13 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -9,7 +9,7 @@ module Ledger ( module Ledger.Account, module Ledger.AccountName, module Ledger.Amount, - module Ledger.Currency, + module Ledger.Commodity, module Ledger.Entry, module Ledger.Ledger, module Ledger.Parse, @@ -24,7 +24,7 @@ where import Ledger.Account import Ledger.AccountName import Ledger.Amount -import Ledger.Currency +import Ledger.Commodity import Ledger.Entry import Ledger.Ledger import Ledger.Parse diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 858a49659..c625d12f0 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -1,7 +1,7 @@ {-| An 'Amount' is some quantity of money, shares, or anything else. -A simple amount is a currency, quantity pair (where currency can be anything): +A simple amount is a commodity, quantity pair (where commodity can be anything): @ $1 @@ -20,9 +20,9 @@ A mixed amount (not yet implemented) is one or more simple amounts: 16h, $13.55, oranges 6 @ -Currencies may be convertible or not (eg, currencies representing -non-money commodities). A mixed amount containing only convertible -currencies can be converted to a simple amount. Arithmetic examples: +Commodities may be convertible or not. A mixed amount containing only +convertible commodities can be converted to a simple amount. Arithmetic +examples: @ $1 - $5 = $-4 @@ -40,7 +40,7 @@ module Ledger.Amount where import Ledger.Utils import Ledger.Types -import Ledger.Currency +import Ledger.Commodity amounttests = TestList [ @@ -48,12 +48,16 @@ amounttests = TestList [ instance Show Amount where show = showAmountRounded --- | Get the string representation of an amount, rounded to its native precision. --- Unlike ledger, we show the decimal digits even if they are all 0, and --- we always show currency symbols on the left. +-- | Get the string representation of an amount, based on its commodity's +-- display settings. showAmountRounded :: Amount -> String -showAmountRounded (Amount c q p) = - (symbol c) ++ ({-punctuatethousands $ -}printf ("%."++show p++"f") q) +showAmountRounded (Amount (Commodity {symbol=sym,side=side,spaced=spaced,precision=p}) q) + | side==L = printf "%s%s%s" sym space quantity + | side==R = printf "%s%s%s" quantity space sym + where + space = if spaced then " " else "" + quantity = punctuatethousands $ printf ("%."++show p++"f") q :: String + punctuatethousands = id -- | Get the string representation of an amount, rounded, or showing just "0" if it's zero. showAmountRoundedOrZero :: Amount -> String @@ -63,11 +67,11 @@ showAmountRoundedOrZero a -- | is this amount zero, when displayed with its given precision ? isZeroAmount :: Amount -> Bool -isZeroAmount a@(Amount c _ _) = nonzerodigits == "" +isZeroAmount a@(Amount c _ ) = nonzerodigits == "" where nonzerodigits = filter (flip notElem "-+,.0") quantitystr - quantitystr = withoutcurrency $ showAmountRounded a - withoutcurrency = drop (length $ symbol c) + quantitystr = withoutsymbol $ showAmountRounded a + withoutsymbol = drop (length $ symbol c) -- XXX punctuatethousands :: String -> String punctuatethousands s = @@ -80,32 +84,30 @@ punctuatethousands s = triples s = [take 3 s] ++ (triples $ drop 3 s) instance Num Amount where - 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) defaultprecision + abs (Amount c q) = Amount c (abs q) + signum (Amount c q) = Amount c (signum q) + fromInteger i = Amount (comm "") (fromInteger i) (+) = amountop (+) (-) = amountop (-) (*) = amountop (*) --- amounts converted from integers will have a default precision, and the --- null currency. -defaultprecision = 2 - -- | Apply a binary arithmetic operator to two amounts, converting to the --- second one's currency and adopting the lowest precision. (Using the --- second currency means that folds (like sum [Amount]) will preserve the --- currency.) +-- second one's commodity and adopting the lowest precision. (Using the +-- second commodity means that folds (like sum [Amount]) will preserve the +-- commodity.) amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount -amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) = - Amount bc ((quantity $ toCurrency bc a) `op` bq) (min ap bp) +amountop op a@(Amount ac aq) b@(Amount bc bq) = + Amount bc ((quantity $ toCommodity bc a) `op` bq) -- | Sum a list of amounts. This is still needed because a final zero --- amount will discard the sum's currency. +-- amount will discard the sum's commodity. sumAmounts :: [Amount] -> Amount sumAmounts = sum . filter (not . isZeroAmount) -toCurrency :: Currency -> Amount -> Amount -toCurrency newc (Amount oldc q p) = - Amount newc (q * (conversionRate oldc newc)) p +toCommodity :: Commodity -> Amount -> Amount +toCommodity newc (Amount oldc q) = + Amount newc (q * (conversionRate oldc newc)) -nullamt = Amount (getcurrency "") 0 2 +nullamt = Amount (comm "") 0 +-- temporary value for partial entries +autoamt = Amount (Commodity {symbol="AUTO",rate=1,side=L,spaced=False,precision=0}) 0 diff --git a/Ledger/Commodity.hs b/Ledger/Commodity.hs new file mode 100644 index 000000000..4c38fac9f --- /dev/null +++ b/Ledger/Commodity.hs @@ -0,0 +1,41 @@ +{-| + +A 'Commodity' is a symbol and a conversion rate relative to the +dollar. Commodity symbols are parsed from the ledger file, rates are +currently hard-coded. + +-} +module Ledger.Commodity +where +import qualified Data.Map as Map +import Ledger.Utils +import Ledger.Types + + +commoditytests = TestList [ + ] + +unknown = Commodity {symbol="",rate=1,side=L,spaced=False,precision=0} +dollar = Commodity {symbol="$",rate=1,side=L,spaced=False,precision=2} +euro = Commodity {symbol="EUR",rate=0.760383,side=L,spaced=False,precision=2} +pound = Commodity {symbol="£",rate=0.512527,side=L,spaced=False,precision=2} +hour = Commodity {symbol="h",rate=100,side=R,spaced=False,precision=1} + +-- | convenient amount constructors +unknowns = Amount unknown +dollars = Amount dollar +euros = Amount euro +pounds = Amount pound +hours = Amount hour + +defaultcommodities = [unknown, dollar, euro, pound, hour] + +defaultcommoditiesmap :: Map.Map String Commodity +defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities] + +comm :: String -> Commodity +comm symbol = Map.findWithDefault (error "commodity lookup failed") symbol defaultcommoditiesmap + +conversionRate :: Commodity -> Commodity -> Double +conversionRate oldc newc = (rate newc) / (rate oldc) + diff --git a/Ledger/Currency.hs b/Ledger/Currency.hs deleted file mode 100644 index b7f9260fe..000000000 --- a/Ledger/Currency.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-| - -A 'Currency' is a symbol and a conversion rate relative to the -dollar. Currency symbols are parsed from the ledger file, rates are -currently hard-coded. - --} -module Ledger.Currency -where -import qualified Data.Map as Map -import Ledger.Utils -import Ledger.Types - - -currencytests = TestList [ - ] - -currencies = - [ - Currency "$" 1 - ,Currency "EUR" 0.760383 - ,Currency "£" 0.512527 - ,Currency "h" 60 -- hours - ,Currency "m" 1 -- minutes - ] - -currencymap = Map.fromList [(sym, c) | c@(Currency sym rate) <- currencies] - -getcurrency :: String -> Currency -getcurrency s = Map.findWithDefault (Currency s 1) s currencymap - -conversionRate :: Currency -> Currency -> Double -conversionRate oldc newc = (rate newc) / (rate oldc) - --- | convenient amount constructors -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/Ledger/Entry.hs b/Ledger/Entry.hs index 820808507..f0417e15c 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -87,11 +87,6 @@ showEntry e = showaccountname s = printf "%-34s" s showcomment s = if (length s) > 0 then " ; "++s else "" -entrySetPrecision :: Int -> Entry -> Entry -entrySetPrecision p (Entry d s c desc comm ts prec) = - Entry d s c desc comm (map (ledgerTransactionSetPrecision p) ts) prec - - -- modifier & periodic entries instance Show ModifierEntry where diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index d9e3db868..e40db657a 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -48,12 +48,11 @@ cacheLedger l = subacctsof a = filter (isAccountNamePrefixOf a) anames subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] balmap = Map.union - (Map.fromList [(a, (sumTransactions $ subtxnsof a){precision=maxprecision}) | a <- anames]) + (Map.fromList [(a, (sumTransactions $ subtxnsof a)) | a <- anames]) (Map.fromList [(a,nullamt) | a <- anames]) amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames] - maxprecision = maximum $ map (precision . amount) ts in - Ledger l ant amap maxprecision + Ledger l ant amap -- | List a 'Ledger' 's account names. accountnames :: Ledger -> [AccountName] @@ -90,10 +89,7 @@ subAccounts l a = map (ledgerAccount l) subacctnames -- display functions, but those are far removed from the ledger. Keep in -- mind if doing more arithmetic with these. ledgerTransactions :: Ledger -> [Transaction] -ledgerTransactions l = - setprecisions $ rawLedgerTransactions $ rawledger l - where - setprecisions = map (transactionSetPrecision (lprecision l)) +ledgerTransactions l = rawLedgerTransactions $ rawledger l -- | Get a ledger's tree of accounts to the specified depth. ledgerAccountTree :: Int -> Ledger -> Tree Account diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index e97c78540..d4becfd1d 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -10,10 +10,12 @@ import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Language import qualified Text.ParserCombinators.Parsec.Token as P import System.IO +import qualified Data.Map as Map import Ledger.Utils import Ledger.Types +import Ledger.Amount import Ledger.Entry -import Ledger.Currency +import Ledger.Commodity import Ledger.TimeLog @@ -255,7 +257,7 @@ ledgertransaction :: Parser RawTransaction ledgertransaction = do many1 spacenonewline account <- ledgeraccountname - amount <- ledgeramount + amount <- transactionamount many spacenonewline comment <- ledgercomment restofline @@ -272,22 +274,55 @@ ledgeraccountname = do -- couldn't avoid consuming a final space sometimes, harmless striptrailingspace s = if last s == ' ' then init s else s -ledgeramount :: Parser Amount -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 +transactionamount :: Parser Amount +transactionamount = + try (do + many1 spacenonewline + a <- try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount <|> return autoamt + return a + ) <|> return autoamt + +leftsymbolamount :: Parser Amount +leftsymbolamount = do + sym <- commoditysymbol + sp <- many spacenonewline + q <- commodityquantity + let newcommodity = Commodity {symbol=sym,rate=1,side=L,spaced=not $ null sp,precision=1} + let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap + return $ Amount c q + "left-symbol amount" + +rightsymbolamount :: Parser Amount +rightsymbolamount = do + q <- commodityquantity + sp <- many spacenonewline + sym <- commoditysymbol + let newcommodity = Commodity {symbol=sym,rate=1,side=R,spaced=not $ null sp,precision=1} + let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap + return $ Amount c q + "right-symbol amount" + +nosymbolamount :: Parser Amount +nosymbolamount = do + q <- commodityquantity + return $ unknowns q + "no-symbol amount" + +commoditysymbol :: Parser String +commoditysymbol = many1 (noneOf "-.0123456789;\n ") "commodity symbol" + +commodityquantity :: Parser Double +commodityquantity = do + q <- many1 (oneOf "-.,0123456789") + let q' = stripcommas $ striptrailingpoint q + let (int,frac) = break (=='.') q' + return $ read q' + "commodity quantity" + where stripcommas = filter (',' /=) striptrailingpoint = reverse . dropWhile (=='.') . reverse - + -- precision = length $ dropWhile (=='.') frac -- XXX + spacenonewline :: Parser Char spacenonewline = satisfy (\c -> c `elem` " \v\f\t") diff --git a/Ledger/RawTransaction.hs b/Ledger/RawTransaction.hs index fd053cb25..358625043 100644 --- a/Ledger/RawTransaction.hs +++ b/Ledger/RawTransaction.hs @@ -36,11 +36,8 @@ autofillTransactions ts = otherwise -> error "too many blank transactions in this entry" where (normals, blanks) = partition isnormal ts - isnormal t = (symbol $ currency $ tamount t) /= "AUTO" + isnormal t = (symbol $ commodity $ tamount t) /= "AUTO" balance t = if isnormal t then t else t{tamount = -(sumLedgerTransactions normals)} sumLedgerTransactions :: [RawTransaction] -> Amount sumLedgerTransactions = sum . map tamount - -ledgerTransactionSetPrecision :: Int -> RawTransaction -> RawTransaction -ledgerTransactionSetPrecision p (RawTransaction a amt c) = RawTransaction a amt{precision=p} c diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index c86de92a9..f2beaff19 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -10,7 +10,7 @@ module Ledger.TimeLog where import Ledger.Utils import Ledger.Types -import Ledger.Currency +import Ledger.Commodity import Ledger.Amount @@ -56,8 +56,7 @@ entryFromTimeLogInOut i o = outdate = showDateFrom outtime intime = parsedatetime $ tldatetime i outtime = parsedatetime $ tldatetime o - hours = realToFrac (diffUTCTime outtime intime) / 3600 - amount = Amount (getcurrency "h") hours 1 + amount = hours $ realToFrac (diffUTCTime outtime intime) / 3600 txns = [RawTransaction acctname amount "", RawTransaction "assets:TIME" (-amount) ""] showDateFrom :: UTCTime -> String diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index a93e5c6dd..b02bf4eba 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -28,9 +28,6 @@ flattenEntry :: (Entry, Int) -> [Transaction] flattenEntry (Entry d _ _ desc _ ts _, e) = [Transaction e d desc (taccount t) (tamount t) | t <- ts] -transactionSetPrecision :: Int -> Transaction -> Transaction -transactionSetPrecision p (Transaction e d desc a amt) = Transaction e d desc a amt{precision=p} - accountNamesFromTransactions :: [Transaction] -> [AccountName] accountNamesFromTransactions ts = nub $ map account ts diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 00539fe18..019110a99 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -15,15 +15,19 @@ type Date = String type DateTime = String -data Currency = Currency { - symbol :: String, - rate :: Double +data Side = L | R deriving (Eq,Show) + +data Commodity = Commodity { + symbol :: String, -- ^ the commodity's symbol + side :: Side, -- ^ should the symbol appear on the left or the right + spaced :: Bool, -- ^ should there be a space between symbol and quantity + precision :: Int, -- ^ number of decimal places to display + rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar } deriving (Eq,Show) data Amount = Amount { - currency :: Currency, - quantity :: Double, - precision :: Int -- ^ number of significant decimal places + commodity :: Commodity, + quantity :: Double } deriving (Eq) type AccountName = String @@ -90,7 +94,6 @@ data Account = Account { data Ledger = Ledger { rawledger :: RawLedger, accountnametree :: Tree AccountName, - accountmap :: Map.Map AccountName Account, - lprecision :: Int -- the preferred display precision + accountmap :: Map.Map AccountName Account } diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index 1568616a1..71ffc012c 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -150,6 +150,8 @@ p = putStr assertequal e a = assertEqual "" e a assertnotequal e a = assertBool "expected inequality, got equality" (e /= a) +-- parsewith :: Parser a parsewith p ts = parse p "" ts +fromparse = either (\_ -> error "parse error") id diff --git a/PrintCommand.hs b/PrintCommand.hs index 5bf272bf2..91da98ce7 100644 --- a/PrintCommand.hs +++ b/PrintCommand.hs @@ -18,5 +18,4 @@ print' :: [Opt] -> [String] -> Ledger -> IO () print' opts args l = putStr $ showEntries opts args l showEntries :: [Opt] -> [String] -> Ledger -> String -showEntries opts args l = concatMap showEntry $ setprecisions $ entries $ rawledger l - where setprecisions = map (entrySetPrecision (lprecision l)) +showEntries opts args l = concatMap showEntry $ entries $ rawledger l diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 0d118383e..13807f447 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -24,7 +24,7 @@ showTransactionsWithBalances opts args l = ts = filter matchtxn $ ledgerTransactions l matchtxn (Transaction _ _ desc acct _) = (containsRegex (regexFor apats) acct) pats@(apats,dpats) = parseAccountDescriptionArgs args - startingbalance = nullamt{precision=lprecision l} + startingbalance = nullamt showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String] showTransactionsWithBalances' [] _ _ = [] showTransactionsWithBalances' (t:ts) tprev b = diff --git a/Tests.hs b/Tests.hs index ddc5a66f6..744e9782a 100644 --- a/Tests.hs +++ b/Tests.hs @@ -23,7 +23,7 @@ alltests = concattests [ ,accountnametests ,amounttests ,balancecommandtests - ,currencytests + ,commoditytests ,entrytests ,ledgertests ,parsertests @@ -41,20 +41,20 @@ tests = [ "display dollar amount" ~: show (dollars 1) ~?= "$1.00" --- ,"display time amount" ~: show (hours 1) ~?= "1.0h" + ,"display time amount" ~: show (hours 1) ~?= "1.0h" - ,"amount precision" ~: do - let a1 = Amount (getcurrency "$") 1.23 1 - let a2 = Amount (getcurrency "$") (-1.23) 2 - let a3 = Amount (getcurrency "$") (-1.23) 3 - assertequal (Amount (getcurrency "$") 0 1) (a1 + a2) - assertequal (Amount (getcurrency "$") 0 1) (a1 + a3) - assertequal (Amount (getcurrency "$") (-2.46) 2) (a2 + a3) - assertequal (Amount (getcurrency "$") (-2.46) 3) (a3 + a3) - -- sum adds 0, with Amount fromIntegral's default precision of 2 - assertequal (Amount (getcurrency "$") 0 1) (sum [a1,a2]) - assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a2,a3]) - assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a3,a3]) +-- ,"amount precision" ~: do +-- let a1 = dollars 1.23 +-- let a2 = Amount (comm "$") (-1.23) 2 +-- let a3 = Amount (comm "$") (-1.23) 3 +-- assertequal (Amount (comm "$") 0 1) (a1 + a2) +-- assertequal (Amount (comm "$") 0 1) (a1 + a3) +-- assertequal (Amount (comm "$") (-2.46) 2) (a2 + a3) +-- assertequal (Amount (comm "$") (-2.46) 3) (a3 + a3) +-- -- sum adds 0, with Amount fromIntegral's default precision of 2 +-- assertequal (Amount (comm "$") 0 1) (sum [a1,a2]) +-- assertequal (Amount (comm "$") (-2.46) 2) (sum [a2,a3]) +-- assertequal (Amount (comm "$") (-2.46) 2) (sum [a3,a3]) ,"ledgertransaction" ~: do assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str) @@ -64,7 +64,7 @@ tests = ,"autofillEntry" ~: do assertequal - (Amount (getcurrency "$") (-47.18) 2) + (dollars (-47.18)) (tamount $ last $ etransactions $ autofillEntry entry1) ,"punctuatethousands" ~: punctuatethousands "" @?= "" @@ -86,9 +86,9 @@ tests = ,"cacheLedger" ~: do assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7 ) - ,"ledgeramount" ~: do - assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18") - assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.") + ,"transactionamount" ~: do + assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18") + assertparseequal (Amount (Commodity {symbol="$",rate=1,side=L,spaced=False,precision=0}) 1) (parsewith transactionamount " $1.") ] balancecommandtests = @@ -202,8 +202,8 @@ entry1_str = "\ entry1 = (Entry "2007/01/28" False "" "coopportunity" "" - [RawTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "", - RawTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""] "") + [RawTransaction "expenses:food:groceries" (dollars 47.18) "", + RawTransaction "assets:checking" (dollars (-47.18)) ""] "") entry2_str = "\ @@ -347,12 +347,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:cash", - tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}, + tamount=dollars 4.82, tcomment="" }, RawTransaction { taccount="equity:opening balances", - tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}, + tamount=dollars (-4.82), tcomment="" } ], @@ -368,12 +368,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:vacation", - tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2}, + tamount=dollars 179.92, tcomment="" }, RawTransaction { taccount="assets:checking", - tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}, + tamount=dollars (-179.92), tcomment="" } ], @@ -389,12 +389,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="assets:saving", - tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}, + tamount=dollars 200, tcomment="" }, RawTransaction { taccount="assets:checking", - tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}, + tamount=dollars (-200), tcomment="" } ], @@ -410,12 +410,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:food:dining", - tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}, + tamount=dollars 4.82, tcomment="" }, RawTransaction { taccount="assets:cash", - tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}, + tamount=dollars (-4.82), tcomment="" } ], @@ -431,12 +431,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="expenses:phone", - tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2}, + tamount=dollars 95.11, tcomment="" }, RawTransaction { taccount="assets:checking", - tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}, + tamount=dollars (-95.11), tcomment="" } ], @@ -452,12 +452,12 @@ rawledger7 = RawLedger etransactions=[ RawTransaction { taccount="liabilities:credit cards:discover", - tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}, + tamount=dollars 80, tcomment="" }, RawTransaction { taccount="assets:checking", - tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}, + tamount=dollars (-80), tcomment="" } ], diff --git a/hledger.hs b/hledger.hs index d43eaf82e..400523f26 100644 --- a/hledger.hs +++ b/hledger.hs @@ -32,6 +32,7 @@ or ghci: -} module Main ( + module Main, module Utils, module Options, module BalanceCommand,