hledger/Ledger/RawLedger.hs

{-|

A 'RawLedger' is a parsed ledger file. We call it raw to distinguish from
the cached 'Ledger'.

-}

module Ledger.RawLedger
where
import qualified Data.Map as Map
import Data.Map ((!))
import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.Entry
import Ledger.Transaction
import Ledger.RawTransaction
import Ledger.TimeLog


instance Show RawLedger where
    show l = printf "RawLedger with %d entries, %d accounts: %s"
             ((length $ entries l) +
              (length $ modifier_entries l) +
              (length $ periodic_entries l))
             (length accounts)
             (show accounts)
             -- ++ (show $ rawLedgerTransactions l)
             where accounts = flatten $ rawLedgerAccountNameTree l

rawLedgerTransactions :: RawLedger -> [Transaction]
rawLedgerTransactions = txnsof . entries
    where txnsof es = concat $ map flattenEntry $ zip es [1..]

rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions

rawLedgerAccountNames :: RawLedger -> [AccountName]
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed

rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l

-- | Remove ledger entries we are not interested in.
-- Keep only those which fall between the begin and end dates, and match
-- the description pattern, and are cleared or real if those options are active.
filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger
filterRawLedger span pats clearedonly realonly = 
    filterRawLedgerTransactionsByRealness realonly .
    filterRawLedgerEntriesByClearedStatus clearedonly .
    filterRawLedgerEntriesByDate span .
    filterRawLedgerEntriesByDescription pats

-- | Keep only entries whose description matches the description patterns.
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) = 
    RawLedger ms ps (filter matchdesc es) f
    where matchdesc = matchpats pats . edescription

-- | Keep only entries which fall between begin and end dates. 
-- We include entries on the begin date and exclude entries on the end
-- date, like ledger.  An empty date string means no restriction.
filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger
filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es f) = 
    RawLedger ms ps (filter matchdate es) f
    where 
      matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end)

-- | Keep only entries with cleared status, if the flag is true, otherwise
-- do no filtering.
filterRawLedgerEntriesByClearedStatus :: Bool -> RawLedger -> RawLedger
filterRawLedgerEntriesByClearedStatus False l = l
filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es f) =
    RawLedger ms ps (filter estatus es) f

-- | Strip out any virtual transactions, if the flag is true, otherwise do
-- no filtering.
filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByRealness False l = l
filterRawLedgerTransactionsByRealness True (RawLedger ms ps es f) =
    RawLedger ms ps (map filtertxns es) f
    where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}

-- | Keep only entries which affect accounts matched by the account patterns.
filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger
filterRawLedgerEntriesByAccount apats (RawLedger ms ps es f) =
    RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) f

-- | Give all a ledger's amounts their canonical display settings.  That
-- is, in each commodity, amounts will use the display settings of the
-- first amount detected, and the greatest precision of the amounts
-- detected. Also, amounts are converted to cost basis if that flag is
-- active.
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
canonicaliseAmounts costbasis l@(RawLedger ms ps es f) = RawLedger ms ps (map fixentry es) f
    where 
      fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr
      fixrawtransaction (RawTransaction ac a c t) = RawTransaction ac (fixmixedamount a) c t
      fixmixedamount (Mixed as) = Mixed $ map fixamount as
      fixamount = fixcommodity . (if costbasis then costOfAmount else id)
      fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
      canonicalcommoditymap = 
          Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
                        let cs = commoditymap ! s,
                        let firstc = head cs,
                        let maxp = maximum $ map precision cs
                       ]
      commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
      commoditieswithsymbol s = filter ((s==) . symbol) commodities
      commoditysymbols = nub $ map symbol commodities
      commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l

-- | Get just the amounts from a ledger, in the order parsed.
rawLedgerAmounts :: RawLedger -> [MixedAmount]
rawLedgerAmounts = map amount . rawLedgerTransactions

-- | Get just the ammount commodities from a ledger, in the order parsed.
rawLedgerCommodities :: RawLedger -> [Commodity]
rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts

-- | Get just the amount precisions from a ledger, in the order parsed.
rawLedgerPrecisions :: RawLedger -> [Int]
rawLedgerPrecisions = map precision . rawLedgerCommodities

rawLedgerConvertTimeLog :: RawLedger -> RawLedger
rawLedgerConvertTimeLog l0 = l0 { entries = convertedTimeLog ++ entries l0
                                , open_timelog_entries = []
                                }
    where convertedTimeLog = entriesFromTimeLogEntries $ open_timelog_entries l0