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

use MixedAmount everywhere. seems to work.

Browse Source
This commit is contained in:
Simon Michael 2008-10-18 08:39:08 +00:00
parent 4f83326f14
commit 648887b36f
10 changed files with 68 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Ledger/Amount.hs
View File

@ -47,6 +47,22 @@ import Ledger.Commodity
instance Show Amount where show = showAmount
-- instance Show MixedAmount where show = showMixedAmount
instance Num Amount where
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 (*)
instance Num MixedAmount where
abs = error "programming error, mixed amounts do not support abs"
signum = error "programming error, mixed amounts do not support signum"
fromInteger i = [Amount (comm "") (fromInteger i)]
negate = map negate
(+) = (++)
(*) = error "programming error, mixed amounts do not support multiplication"
showMixedAmount :: MixedAmount -> String
showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as
@ -60,9 +76,6 @@ groupAmountsByCommodity as = grouped
hassymbol s a = s == (symbol $ commodity a)
symbols = sort $ nub $ map (symbol . commodity) as
-- samecommoditysymbol Amount{commodity=c1} Amount{commodity=c2} = samesymbol c1 c2
-- samesymbol Commodity{symbol=s1} Commodity{symbol=s2} = s1==s2
-- | Get the string representation of an amount, based on its commodity's
-- display settings.
showAmount :: Amount -> String
@ -91,6 +104,12 @@ showAmountOrZero a
| isZeroAmount a = "0"
| otherwise = showAmount a
-- | Get the string representation of an amount, rounded, or showing just "0" if it's zero.
showMixedAmountOrZero :: MixedAmount -> String
showMixedAmountOrZero a
| isZeroMixedAmount a = "0"
| otherwise = showMixedAmount a
-- | is this amount zero, when displayed with its given precision ?
isZeroAmount :: Amount -> Bool
isZeroAmount a@(Amount c _ ) = nonzerodigits == ""
@ -99,14 +118,6 @@ isZeroAmount a@(Amount c _ ) = nonzerodigits == ""
isZeroMixedAmount :: MixedAmount -> Bool
isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount
instance Num Amount where
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 (*)
-- | Apply a binary arithmetic operator to two amounts, converting to the
-- second one's commodity and adopting the lowest precision. (Using the
-- second commodity means that folds (like sum [Amount]) will preserve the
@ -128,7 +139,7 @@ sumAmounts = sum . filter (not . isZeroAmount)
sumMixedAmounts :: [MixedAmount] -> MixedAmount
sumMixedAmounts = concat
nullamt = Amount (comm "") 0
nullamt = []
-- temporary value for partial entries
autoamt = Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0
autoamt = [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0]

10
Ledger/Entry.hs
View File

@ -53,7 +53,7 @@ showEntry e =
showtxn t = showacct t ++ " " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t)
showtxnnoamt t = showacct t ++ " " ++ (showcomment $ tcomment t)
showacct t = " " ++ (showaccountname $ taccount t)
showamount = printf "%12s" . showAmount
showamount = printf "%12s" . showMixedAmount
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
@ -77,9 +77,9 @@ balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'}
1 -> map balance ts
otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e
otherstotal = sumRawTransactions withamounts
simpleotherstotal
| length otherstotal == 1 = head otherstotal
| otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e
-- simpleotherstotal
-- | length otherstotal == 1 = head otherstotal
-- | otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e
balance t
| isReal t && not (hasAmount t) = t{tamount = -simpleotherstotal}
| isReal t && not (hasAmount t) = t{tamount = -otherstotal}
| otherwise = t

14
Ledger/Parse.hs
View File

@ -301,7 +301,7 @@ ledgeraccountname = do
accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
<?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
transactionamount :: Parser Amount
transactionamount :: Parser MixedAmount
transactionamount =
try (do
many1 spacenonewline
@ -309,29 +309,29 @@ transactionamount =
return a
) <|> return autoamt
leftsymbolamount :: Parser Amount
leftsymbolamount :: Parser MixedAmount
leftsymbolamount = do
sym <- commoditysymbol
sp <- many spacenonewline
(q,p,comma) <- amountquantity
let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1}
return $ Amount c q
return [Amount c q]
<?> "left-symbol amount"
rightsymbolamount :: Parser Amount
rightsymbolamount :: Parser MixedAmount
rightsymbolamount = do
(q,p,comma) <- amountquantity
sp <- many spacenonewline
sym <- commoditysymbol
let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1}
return $ Amount c q
return [Amount c q]
<?> "right-symbol amount"
nosymbolamount :: Parser Amount
nosymbolamount :: Parser MixedAmount
nosymbolamount = do
(q,p,comma) <- amountquantity
let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1}
return $ Amount c q
return [Amount c q]
<?> "no-symbol amount"
commoditysymbol :: Parser String

6
Ledger/RawLedger.hs
View File

@ -11,6 +11,7 @@ import qualified Data.Map as Map
import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.Entry
import Ledger.Transaction
@ -104,10 +105,9 @@ normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f
normaliseEntryAmounts (Entry d s c desc comm ts pre) = Entry d s c desc comm ts' pre
where ts' = map normaliseRawTransactionAmounts ts
normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t
where a' = normaliseAmount a
normaliseAmount (Amount c q) = Amount (firstoccurrenceof c) q
where a' = normaliseMixedAmount a
firstcommodities = nubBy samesymbol $ allcommodities
allcommodities = map (commodity . amount) $ rawLedgerTransactions l
allcommodities = map commodity $ concat $ map amount $ rawLedgerTransactions l
samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2
firstoccurrenceof c@(Commodity {symbol=s}) =
fromMaybe

6
Ledger/RawTransaction.hs
View File

@ -20,7 +20,7 @@ showRawTransaction (RawTransaction a amt _ ttype) =
showaccountname a ++ " " ++ (showamount amt)
where
showaccountname = printf "%-22s" . bracket . elideAccountName width
showamount = printf "%12s" . showAmountOrZero
showamount = printf "%12s" . showMixedAmountOrZero
(bracket,width) = case ttype of
BalancedVirtualTransaction -> (\s -> "["++s++"]", 20)
VirtualTransaction -> (\s -> "("++s++")", 20)
@ -30,7 +30,7 @@ isReal :: RawTransaction -> Bool
isReal t = rttype t == RegularTransaction
hasAmount :: RawTransaction -> Bool
hasAmount = ("AUTO" /=) . symbol . commodity . tamount
hasAmount = (/= autoamt) . tamount
sumRawTransactions :: [RawTransaction] -> MixedAmount
sumRawTransactions = normaliseMixedAmount . map tamount
sumRawTransactions = normaliseMixedAmount . sumMixedAmounts . map tamount

2
Ledger/TimeLog.hs
View File

@ -57,7 +57,7 @@ entryFromTimeLogInOut i o =
showdate = formatTime defaultTimeLocale "%Y/%m/%d"
intime = parsedatetime $ tldatetime i
outtime = parsedatetime $ tldatetime o
amount = hours $ realToFrac (diffUTCTime outtime intime) / 3600
amount = [hours $ realToFrac (diffUTCTime outtime intime) / 3600]
txns = [RawTransaction acctname amount "" RegularTransaction
--,RawTransaction "assets:time" (-amount) "" RegularTransaction
]

3
Ledger/Transaction.hs
View File

@ -30,7 +30,6 @@ accountNamesFromTransactions :: [Transaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts
sumTransactions :: [Transaction] -> MixedAmount
-- sumTransactions = sum . map amount
sumTransactions = map amount
sumTransactions = sumMixedAmounts . map amount
nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction

4
Ledger/Types.hs
View File

@ -41,7 +41,7 @@ data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtual
data RawTransaction = RawTransaction {
taccount :: AccountName,
tamount :: Amount,
tamount :: MixedAmount,
tcomment :: String,
rttype :: TransactionType
} deriving (Eq)
@ -90,7 +90,7 @@ data Transaction = Transaction {
date :: Date,
description :: String,
account :: AccountName,
amount :: Amount,
amount :: MixedAmount,
ttype :: TransactionType
} deriving (Eq)

6
RegisterCommand.hs
View File

@ -35,19 +35,19 @@ showRegisterReport opts args l = showtxns ts nulltxn nullamt
-- show transactions, one per line, with a running balance
showtxns [] _ _ = ""
showtxns (t@Transaction{amount=a}:ts) tprev bal =
(if isZeroAmount a then "" else this) ++ showtxns ts t bal'
(if isZeroMixedAmount a then "" else this) ++ showtxns ts t bal'
where
this = showtxn (t `issame` tprev) t bal'
issame t1 t2 = entryno t1 == entryno t2
bal' = bal + amount t
-- show one transaction line, with or without the entry details
showtxn :: Bool -> Transaction -> Amount -> String
showtxn :: Bool -> Transaction -> MixedAmount -> String
showtxn omitdesc t b = entrydesc ++ txn ++ bal ++ "\n"
where
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
date = showDate $ da
desc = printf "%-20s" $ elideRight 20 de :: String
txn = showRawTransaction $ RawTransaction a amt "" tt
bal = printf " %12s" (showAmountOrZero b)
bal = printf " %12s" (showMixedAmountOrZero b)
Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t

38
Tests.hs
View File

@ -78,7 +78,7 @@ unittests = TestList [
,
"balanceEntry" ~: do
assertequal
(dollars (-47.18))
[dollars (-47.18)]
(tamount $ last $ etransactions $ balanceEntry entry1)
,
"punctuatethousands" ~: punctuatethousands "" @?= ""
@ -103,8 +103,8 @@ unittests = TestList [
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7)
,
"transactionamount" ~: do
assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18")
assertparseequal (Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1) (parsewith transactionamount " $1.")
assertparseequal [dollars 47.18] (parsewith transactionamount " $47.18")
assertparseequal [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1] (parsewith transactionamount " $1.")
]
------------------------------------------------------------------------------
@ -215,7 +215,7 @@ balancecommandtests = TestList [
]
registercommandtests = TestList [
"register does something" ~:
"register report" ~:
do
l <- ledgerfromfile "sample.ledger"
assertequal (
@ -243,7 +243,7 @@ assertparseequal expected parsed = either printParseError (assertequal expected)
rawtransaction1_str = " expenses:food:dining $10.00\n"
rawtransaction1 = RawTransaction "expenses:food:dining" (dollars 10) "" RegularTransaction
rawtransaction1 = RawTransaction "expenses:food:dining" [dollars 10] "" RegularTransaction
entry1_str = "\
\2007/01/28 coopportunity\n\
@ -253,8 +253,8 @@ entry1_str = "\
entry1 =
(Entry "2007/01/28" False "" "coopportunity" ""
[RawTransaction "expenses:food:groceries" (dollars 47.18) "" RegularTransaction,
RawTransaction "assets:checking" (dollars (-47.18)) "" RegularTransaction] "")
[RawTransaction "expenses:food:groceries" [dollars 47.18] "" RegularTransaction,
RawTransaction "assets:checking" [dollars (-47.18)] "" RegularTransaction] "")
entry2_str = "\
@ -398,13 +398,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:cash",
tamount=dollars 4.82,
tamount=[dollars 4.82],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="equity:opening balances",
tamount=dollars (-4.82),
tamount=[dollars (-4.82)],
tcomment="",
rttype=RegularTransaction
}
@ -421,13 +421,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:vacation",
tamount=dollars 179.92,
tamount=[dollars 179.92],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-179.92),
tamount=[dollars (-179.92)],
tcomment="",
rttype=RegularTransaction
}
@ -444,13 +444,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:saving",
tamount=dollars 200,
tamount=[dollars 200],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-200),
tamount=[dollars (-200)],
tcomment="",
rttype=RegularTransaction
}
@ -467,13 +467,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:food:dining",
tamount=dollars 4.82,
tamount=[dollars 4.82],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:cash",
tamount=dollars (-4.82),
tamount=[dollars (-4.82)],
tcomment="",
rttype=RegularTransaction
}
@ -490,13 +490,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:phone",
tamount=dollars 95.11,
tamount=[dollars 95.11],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-95.11),
tamount=[dollars (-95.11)],
tcomment="",
rttype=RegularTransaction
}
@ -513,13 +513,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="liabilities:credit cards:discover",
tamount=dollars 80,
tamount=[dollars 80],
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-80),
tamount=[dollars (-80)],
tcomment="",
rttype=RegularTransaction
}