separate confusing "normalise" uses, begin to fix broken amount display prefs
This commit is contained in:
parent
17ab6cb0ab
commit
5c0ff1daa5
@ -107,19 +107,19 @@ matchLedgerPatterns forbalancereport pats str =
|
||||
then accountLeafName str
|
||||
else str
|
||||
|
||||
-- | Give amounts the display settings of the first one detected in each commodity.
|
||||
normaliseRawLedgerAmounts :: RawLedger -> RawLedger
|
||||
normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f
|
||||
-- | Give all amounts the display settings of the first one detected in each commodity.
|
||||
setAmountDisplayPrefs :: RawLedger -> RawLedger
|
||||
setAmountDisplayPrefs l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAmounts es) f
|
||||
where
|
||||
es' = map normaliseEntryAmounts es
|
||||
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' = normaliseMixedAmount a
|
||||
firstcommodities = nubBy samesymbol $ allcommodities
|
||||
fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr
|
||||
fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t
|
||||
fixMixedAmount (Mixed as) = Mixed $ map fixAmount as
|
||||
fixAmount (Amount c q) = Amount (firstoccurrenceof c) q
|
||||
allcommodities = map commodity $ concat $ map (amounts . amount) $ rawLedgerTransactions l
|
||||
firstcommodities = nubBy samesymbol $ allcommodities
|
||||
samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2
|
||||
firstoccurrenceof c@(Commodity {symbol=s}) =
|
||||
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)
|
||||
-- XXX actually ledger uses the greatest precision found
|
||||
|
||||
14
hledger.hs
14
hledger.hs
@ -68,12 +68,12 @@ main = do
|
||||
-- (or report a parse error). This function makes the whole thing go.
|
||||
parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
|
||||
parseLedgerAndDo opts args cmd =
|
||||
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
|
||||
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd
|
||||
where
|
||||
runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared real
|
||||
begin = beginDateFromOpts opts
|
||||
end = endDateFromOpts opts
|
||||
cleared = Cleared `elem` opts
|
||||
real = Real `elem` opts
|
||||
descpats = snd $ parseAccountDescriptionArgs args
|
||||
runcmd = cmd opts args . cacheLedger . setAmountDisplayPrefs . filterRawLedger b e dpats c r
|
||||
b = beginDateFromOpts opts
|
||||
e = endDateFromOpts opts
|
||||
dpats = snd $ parseAccountDescriptionArgs args
|
||||
c = Cleared `elem` opts
|
||||
r = Real `elem` opts
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user