separate confusing "normalise" uses, begin to fix broken amount display prefs

This commit is contained in:
Simon Michael 2008-10-18 21:10:08 +00:00
parent 17ab6cb0ab
commit 5c0ff1daa5
2 changed files with 17 additions and 17 deletions

View File

@ -107,19 +107,19 @@ matchLedgerPatterns forbalancereport pats str =
then accountLeafName str then accountLeafName str
else str else str
-- | Give amounts the display settings of the first one detected in each commodity. -- | Give all amounts the display settings of the first one detected in each commodity.
normaliseRawLedgerAmounts :: RawLedger -> RawLedger setAmountDisplayPrefs :: RawLedger -> RawLedger
normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f setAmountDisplayPrefs l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAmounts es) f
where where
es' = map normaliseEntryAmounts es fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr
normaliseEntryAmounts (Entry d s c desc comm ts pre) = Entry d s c desc comm ts' pre fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t
where ts' = map normaliseRawTransactionAmounts ts fixMixedAmount (Mixed as) = Mixed $ map fixAmount as
normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t fixAmount (Amount c q) = Amount (firstoccurrenceof c) q
where a' = normaliseMixedAmount a
firstcommodities = nubBy samesymbol $ allcommodities
allcommodities = map commodity $ concat $ map (amounts . amount) $ rawLedgerTransactions l allcommodities = map commodity $ concat $ map (amounts . amount) $ rawLedgerTransactions l
firstcommodities = nubBy samesymbol $ allcommodities
samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2 samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2
firstoccurrenceof c@(Commodity {symbol=s}) = firstoccurrenceof c@(Commodity {symbol=s}) =
fromMaybe fromMaybe
(error "failed to normalise commodity") -- shouldn't happen (error $ "failed to find commodity "++s) -- shouldn't happen
(find (\(Commodity {symbol=sym}) -> sym==s) firstcommodities) (find (\(Commodity {symbol=sym}) -> sym==s) firstcommodities)
-- XXX actually ledger uses the greatest precision found

View File

@ -68,12 +68,12 @@ main = do
-- (or report a parse error). This function makes the whole thing go. -- (or report a parse error). This function makes the whole thing go.
parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO () parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
parseLedgerAndDo opts args cmd = parseLedgerAndDo opts args cmd =
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd
where where
runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared real runcmd = cmd opts args . cacheLedger . setAmountDisplayPrefs . filterRawLedger b e dpats c r
begin = beginDateFromOpts opts b = beginDateFromOpts opts
end = endDateFromOpts opts e = endDateFromOpts opts
cleared = Cleared `elem` opts dpats = snd $ parseAccountDescriptionArgs args
real = Real `elem` opts c = Cleared `elem` opts
descpats = snd $ parseAccountDescriptionArgs args r = Real `elem` opts