simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-19 10:17:35 +03:00
Code Issues Projects Releases Wiki Activity

try making MixedAmount a full newtype, to avoid TypeSynonymInstances error

Browse Source
This commit is contained in:
Simon Michael 2008-10-18 10:38:01 +00:00
parent 2d41368b8b
commit 80beac7d43
11 changed files with 49 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
BalanceCommand.hs
View File

@ -131,7 +131,7 @@ showBalanceReport opts args l = acctsstr ++ totalstr
acctstoshow = balancereportaccts showingsubs apats l
acctnamestoshow = map aname acctstoshow
treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l
total = sumMixedAmounts $ map abalance $ nonredundantaccts
total = sum $ map abalance $ nonredundantaccts
nonredundantaccts = filter (not . hasparentshowing) acctstoshow
hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow

2
Ledger/Account.hs
View File

@ -19,5 +19,5 @@ instance Show Account where
instance Eq Account where
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
nullacct = Account "" [] []
nullacct = Account "" [] nullamt

35
Ledger/Amount.hs
View File

@ -45,6 +45,7 @@ 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)
@ -55,18 +56,22 @@ instance Num Amount where
(*) = amountop (*)
instance Num MixedAmount where
abs = error "programming error, mixed amounts do not support abs"
fromInteger i = Mixed [Amount (comm "") (fromInteger i)]
negate (Mixed as) = Mixed $ map negate as
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs
(*) = error "programming error, mixed amounts do not support multiplication"
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"
amounts :: MixedAmount -> [Amount]
amounts (Mixed as) = as
showMixedAmount :: MixedAmount -> String
showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as
showMixedAmount m = concat $ intersperse ", " $ map show as
where (Mixed as) = normaliseMixedAmount m
normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount as = map sumAmounts $ groupAmountsByCommodity as
normaliseMixedAmount (Mixed as) = Mixed $ map sum $ groupAmountsByCommodity as
groupAmountsByCommodity :: [Amount] -> [[Amount]]
groupAmountsByCommodity as = grouped
@ -115,7 +120,7 @@ isZeroAmount a@(Amount c _ ) = nonzerodigits == ""
where nonzerodigits = filter (`elem` "123456789") $ showAmount a
isZeroMixedAmount :: MixedAmount -> Bool
isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount
isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
-- | Apply a binary arithmetic operator to two amounts, converting to the
-- second one's commodity and adopting the lowest precision. (Using the
@ -130,15 +135,9 @@ amountop op a@(Amount ac aq) b@(Amount bc bq) =
convertAmountTo :: Commodity -> Amount -> Amount
convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2)
-- | Sum a list of amounts. This is still needed because a final zero
-- amount will discard the sum's commodity.
sumAmounts :: [Amount] -> Amount
sumAmounts = sum . filter (not . isZeroAmount)
sumMixedAmounts :: [MixedAmount] -> MixedAmount
sumMixedAmounts = normaliseMixedAmount . concat
nullamt = []
nullamt :: MixedAmount
nullamt = Mixed []
-- temporary value for partial entries
autoamt = [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0]
autoamt :: MixedAmount
autoamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0]

4
Ledger/Entry.hs
View File

@ -61,7 +61,7 @@ showDate = printf "%-10s"
isEntryBalanced :: Entry -> Bool
isEntryBalanced (Entry {etransactions=ts}) =
isZeroMixedAmount $ sumMixedAmounts $ map tamount $ filter isReal ts
isZeroMixedAmount $ sum $ map tamount $ filter isReal ts
-- | Fill in a missing balance in this entry, if we have enough
-- information to do that. Excluding virtual transactions, there should be
@ -74,7 +74,7 @@ balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'}
0 -> ts
1 -> map balance ts
otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e
otherstotal = sumMixedAmounts $ map tamount withamounts
otherstotal = sum $ map tamount withamounts
balance t
| isReal t && not (hasAmount t) = t{tamount = -otherstotal}
| otherwise = t

2
Ledger/Ledger.hs
View File

@ -45,7 +45,7 @@ cacheLedger l = Ledger l ant amap
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
(Map.fromList [(a,[]) | a <- anames])
(Map.fromList [(a,Mixed []) | a <- anames])
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
-- | List a ledger's account names.

6
Ledger/Parse.hs
View File

@ -315,7 +315,7 @@ leftsymbolamount = do
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 $ Mixed [Amount c q]
<?> "left-symbol amount"
rightsymbolamount :: Parser MixedAmount
@ -324,14 +324,14 @@ rightsymbolamount = do
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 $ Mixed [Amount c q]
<?> "right-symbol 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 $ Mixed [Amount c q]
<?> "no-symbol amount"
commoditysymbol :: Parser String

2
Ledger/RawLedger.hs
View File

@ -100,7 +100,7 @@ normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f
normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t
where a' = normaliseMixedAmount a
firstcommodities = nubBy samesymbol $ allcommodities
allcommodities = map commodity $ concat $ map amount $ rawLedgerTransactions l
allcommodities = map commodity $ concat $ map (amounts . amount) $ rawLedgerTransactions l
samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2
firstoccurrenceof c@(Commodity {symbol=s}) =
fromMaybe

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 = Mixed [hours $ realToFrac (diffUTCTime outtime intime) / 3600]
txns = [RawTransaction acctname amount "" RegularTransaction
--,RawTransaction "assets:time" (-amount) "" RegularTransaction
]

2
Ledger/Transaction.hs
View File

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

6
Ledger/Types.hs
View File

@ -15,6 +15,8 @@ type Date = String
type DateTime = String
type AccountName = String
data Side = L | R deriving (Eq,Show)
data Commodity = Commodity {
@ -34,9 +36,7 @@ data Amount = Amount {
quantity :: Double
} deriving (Eq)
type MixedAmount = [Amount]
type AccountName = String
newtype MixedAmount = Mixed [Amount] deriving (Eq)
data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction
deriving (Eq,Show)

36
Tests.hs
View File

@ -78,7 +78,7 @@ unittests = TestList [
,
"balanceEntry" ~: do
assertequal
[dollars (-47.18)]
(Mixed [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 (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18")
assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1]) (parsewith transactionamount " $1.")
]
------------------------------------------------------------------------------
@ -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"(Mixed [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" (Mixed [dollars 47.18]) "" RegularTransaction,
RawTransaction "assets:checking" (Mixed [dollars (-47.18)]) "" RegularTransaction] "")
entry2_str = "\
@ -398,13 +398,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:cash",
tamount=[dollars 4.82],
tamount=(Mixed [dollars 4.82]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="equity:opening balances",
tamount=[dollars (-4.82)],
tamount=(Mixed [dollars (-4.82)]),
tcomment="",
rttype=RegularTransaction
}
@ -421,13 +421,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:vacation",
tamount=[dollars 179.92],
tamount=(Mixed [dollars 179.92]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=[dollars (-179.92)],
tamount=(Mixed [dollars (-179.92)]),
tcomment="",
rttype=RegularTransaction
}
@ -444,13 +444,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:saving",
tamount=[dollars 200],
tamount=(Mixed [dollars 200]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=[dollars (-200)],
tamount=(Mixed [dollars (-200)]),
tcomment="",
rttype=RegularTransaction
}
@ -467,13 +467,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:food:dining",
tamount=[dollars 4.82],
tamount=(Mixed [dollars 4.82]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:cash",
tamount=[dollars (-4.82)],
tamount=(Mixed [dollars (-4.82)]),
tcomment="",
rttype=RegularTransaction
}
@ -490,13 +490,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:phone",
tamount=[dollars 95.11],
tamount=(Mixed [dollars 95.11]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=[dollars (-95.11)],
tamount=(Mixed [dollars (-95.11)]),
tcomment="",
rttype=RegularTransaction
}
@ -513,13 +513,13 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="liabilities:credit cards:discover",
tamount=[dollars 80],
tamount=(Mixed [dollars 80]),
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=[dollars (-80)],
tamount=(Mixed [dollars (-80)]),
tcomment="",
rttype=RegularTransaction
}