diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 8cd421618..18ddf78eb 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -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 diff --git a/hledger.hs b/hledger.hs index 62a4f9a9f..916403103 100644 --- a/hledger.hs +++ b/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