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.LedgerTransaction
import Ledger.Transaction
import Ledger.Posting
import Ledger.TimeLog
instance Show RawLedger where
show l = printf "RawLedger with %d transactions, %d accounts: %s"
((length $ ledger_txns l) +
(length $ modifier_txns l) +
(length $ periodic_txns l))
(length accounts)
(show accounts)
where accounts = flatten $ rawLedgerAccountNameTree l
rawLedgerEmpty :: RawLedger
rawLedgerEmpty = RawLedger { modifier_txns = []
, periodic_txns = []
, ledger_txns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
, filepath = ""
}
addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger
addLedgerTransaction t l0 = l0 { ledger_txns = t : (ledger_txns l0) }
addModifierTransaction :: ModifierTransaction -> RawLedger -> RawLedger
addModifierTransaction mt l0 = l0 { modifier_txns = mt : (modifier_txns l0) }
addPeriodicTransaction :: PeriodicTransaction -> RawLedger -> RawLedger
addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : (periodic_txns l0) }
addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger
addHistoricalPrice h l0 = l0 { historical_prices = h : (historical_prices l0) }
addTimeLogEntry :: TimeLogEntry -> RawLedger -> RawLedger
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : (open_timelog_entries l0) }
rawLedgerTransactions :: RawLedger -> [Transaction]
rawLedgerTransactions = txnsof . ledger_txns
where txnsof ts = concat $ map flattenLedgerTransaction $ zip ts [1..]
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
rawLedgerAccountNames :: RawLedger -> [AccountName]
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
filterRawLedger :: DateSpan -> [String] -> Maybe Bool -> Bool -> RawLedger -> RawLedger
filterRawLedger span pats clearedonly realonly =
filterRawLedgerPostingsByRealness realonly .
filterRawLedgerTransactionsByClearedStatus clearedonly .
filterRawLedgerTransactionsByDate span .
filterRawLedgerTransactionsByDescription pats
filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp) =
RawLedger ms ps (filter matchdesc ts) tls hs f fp
where matchdesc = matchpats pats . ltdescription
filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp) =
RawLedger ms ps (filter matchdate ts) tls hs f fp
where
matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end)
filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByClearedStatus Nothing rl = rl
filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f fp) =
RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp
filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerPostingsByRealness False l = l
filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp) =
RawLedger mts pts (map filtertxns ts) tls hs f fp
where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger
filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f fp) =
RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp
where filtertxns t@LedgerTransaction{ltpostings=ps} =
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) =
RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp
where
fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr
fixrawposting (Posting s ac a c t) = Posting s 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 . tamount) $ rawLedgerTransactions l
rawLedgerAmounts :: RawLedger -> [MixedAmount]
rawLedgerAmounts = map tamount . rawLedgerTransactions
rawLedgerCommodities :: RawLedger -> [Commodity]
rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
rawLedgerPrecisions :: RawLedger -> [Int]
rawLedgerPrecisions = map precision . rawLedgerCommodities
rawLedgerConvertTimeLog :: LocalTime -> RawLedger -> RawLedger
rawLedgerConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0
, open_timelog_entries = []
}
where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0
rawLedgerDateSpan :: RawLedger -> DateSpan
rawLedgerDateSpan rl
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ ltdate $ head ts) (Just $ addDays 1 $ ltdate $ last ts)
where
ts = sortBy (comparing ltdate) $ ledger_txns rl