1 {-|
    2 
    3 A compound data type for efficiency. A 'Ledger' caches information derived
    4 from a 'RawLedger' for easier querying. Also it typically has had
    5 uninteresting 'LedgerTransaction's and 'Posting's filtered out. It
    6 contains:
    7 
    8 - the original unfiltered 'RawLedger'
    9 
   10 - a tree of 'AccountName's
   11 
   12 - a map from account names to 'Account's
   13 
   14 - the full text of the journal file, when available
   15 
   16 This is the main object you'll deal with as a user of the Ledger
   17 library. The most useful functions also have shorter, lower-case
   18 aliases for easier interaction. Here's an example:
   19 
   20 > > import Ledger
   21 > > l <- readLedger "sample.ledger"
   22 > > accountnames l
   23 > ["assets","assets:bank","assets:bank:checking","assets:bank:saving",...
   24 > > accounts l
   25 > [Account assets with 0 txns and $-1 balance,Account assets:bank with...
   26 > > topaccounts l
   27 > [Account assets with 0 txns and $-1 balance,Account expenses with...
   28 > > account l "assets"
   29 > Account assets with 0 txns and $-1 balance
   30 > > accountsmatching ["ch"] l
   31 > accountsmatching ["ch"] l
   32 > [Account assets:bank:checking with 4 txns and $0 balance]
   33 > > subaccounts l (account l "assets")
   34 > subaccounts l (account l "assets")
   35 > [Account assets:bank with 0 txns and $1 balance,Account assets:cash...
   36 > > head $ transactions l
   37 > 2008/01/01 income assets:bank:checking $1 RegularPosting
   38 > > accounttree 2 l
   39 > Node {rootLabel = Account top with 0 txns and 0 balance, subForest = [...
   40 > > accounttreeat l (account l "assets")
   41 > Just (Node {rootLabel = Account assets with 0 txns and $-1 balance, ...
   42 > > datespan l
   43 > DateSpan (Just 2008-01-01) (Just 2009-01-01)
   44 > > rawdatespan l
   45 > DateSpan (Just 2008-01-01) (Just 2009-01-01)
   46 > > ledgeramounts l
   47 > [$1,$-1,$1,$-1,$1,$-1,$1,$1,$-2,$1,$-1]
   48 > > commodities l
   49 > [Commodity {symbol = "$", side = L, spaced = False, comma = False, ...
   50 
   51 
   52 -}
   53 
   54 module Ledger.Ledger
   55 where
   56 import qualified Data.Map as Map
   57 import Data.Map ((!))
   58 import Ledger.Utils
   59 import Ledger.Types
   60 import Ledger.Amount
   61 import Ledger.AccountName
   62 import Ledger.Account
   63 import Ledger.Transaction
   64 import Ledger.RawLedger
   65 import Ledger.LedgerTransaction
   66 
   67 
   68 instance Show Ledger where
   69     show l = printf "Ledger with %d transactions, %d accounts\n%s"
   70              ((length $ ledger_txns $ rawledger l) +
   71               (length $ modifier_txns $ rawledger l) +
   72               (length $ periodic_txns $ rawledger l))
   73              (length $ accountnames l)
   74              (showtree $ accountnametree l)
   75 
   76 -- | Convert a raw ledger to a more efficient cached type, described above.  
   77 cacheLedger :: [String] -> RawLedger -> Ledger
   78 cacheLedger apats l = Ledger{rawledgertext="",rawledger=l,accountnametree=ant,accountmap=acctmap}
   79     where
   80       (ant,txnsof,_,inclbalof) = groupTransactions $ filtertxns apats $ rawLedgerTransactions l
   81       acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
   82           where mkacct a = Account a (txnsof a) (inclbalof a)
   83 
   84 -- | Given a list of transactions, return an account name tree and three
   85 -- query functions that fetch transactions, balance, and
   86 -- subaccount-including balance by account name. 
   87 -- This is to factor out common logic from cacheLedger and
   88 -- summariseTransactionsInDateSpan.
   89 groupTransactions :: [Transaction] -> (Tree AccountName,
   90                                      (AccountName -> [Transaction]), 
   91                                      (AccountName -> MixedAmount), 
   92                                      (AccountName -> MixedAmount))
   93 groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
   94     where
   95       txnanames = sort $ nub $ map taccount ts
   96       ant = accountNameTreeFrom $ expandAccountNames $ txnanames
   97       allanames = flatten ant
   98       txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
   99       balmap = Map.fromList $ flatten $ calculateBalances ant txnsof
  100       txnsof = (txnmap !) 
  101       exclbalof = fst . (balmap !)
  102       inclbalof = snd . (balmap !)
  103 -- debug
  104 --       txnsof a = (txnmap ! (trace ("ts "++a) a))
  105 --       exclbalof a = fst $ (balmap ! (trace ("eb "++a) a))
  106 --       inclbalof a = snd $ (balmap ! (trace ("ib "++a) a))
  107 
  108 -- | Add subaccount-excluding and subaccount-including balances to a tree
  109 -- of account names somewhat efficiently, given a function that looks up
  110 -- transactions by account name.
  111 calculateBalances :: Tree AccountName -> (AccountName -> [Transaction]) -> Tree (AccountName, (MixedAmount, MixedAmount))
  112 calculateBalances ant txnsof = addbalances ant
  113     where 
  114       addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
  115           where
  116             bal         = sumTransactions $ txnsof a
  117             subsbal     = sum $ map (snd . snd . root) subs'
  118             subs'       = map addbalances subs
  119 
  120 -- | Convert a list of transactions to a map from account name to the list
  121 -- of all transactions in that account. 
  122 transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
  123 transactionsByAccount ts = m'
  124     where
  125       sortedts = sortBy (comparing taccount) ts
  126       groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts
  127       m' = Map.fromList [(taccount $ head g, g) | g <- groupedts]
  128 -- The special account name "top" can be used to look up all transactions. ?
  129 --      m' = Map.insert "top" sortedts m
  130 
  131 filtertxns :: [String] -> [Transaction] -> [Transaction]
  132 filtertxns apats ts = filter (matchpats apats . taccount) ts
  133 
  134 -- | List a ledger's account names.
  135 ledgerAccountNames :: Ledger -> [AccountName]
  136 ledgerAccountNames l = drop 1 $ flatten $ accountnametree l
  137 
  138 -- | Get the named account from a ledger.
  139 ledgerAccount :: Ledger -> AccountName -> Account
  140 ledgerAccount l a = (accountmap l) ! a
  141 
  142 -- | List a ledger's accounts, in tree order
  143 ledgerAccounts :: Ledger -> [Account]
  144 ledgerAccounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
  145 
  146 -- | List a ledger's top-level accounts, in tree order
  147 ledgerTopAccounts :: Ledger -> [Account]
  148 ledgerTopAccounts l = map root $ branches $ ledgerAccountTree 9999 l
  149 
  150 -- | Accounts in ledger whose name matches the pattern, in tree order.
  151 ledgerAccountsMatching :: [String] -> Ledger -> [Account]
  152 ledgerAccountsMatching pats l = filter (matchpats pats . aname) $ accounts l
  153 
  154 -- | List a ledger account's immediate subaccounts
  155 ledgerSubAccounts :: Ledger -> Account -> [Account]
  156 ledgerSubAccounts l Account{aname=a} = 
  157     map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
  158 
  159 -- | List a ledger's "transactions", ie postings with transaction info attached.
  160 ledgerTransactions :: Ledger -> [Transaction]
  161 ledgerTransactions l = rawLedgerTransactions $ rawledger l
  162 
  163 -- | Get a ledger's tree of accounts to the specified depth.
  164 ledgerAccountTree :: Int -> Ledger -> Tree Account
  165 ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree l
  166 
  167 -- | Get a ledger's tree of accounts rooted at the specified account.
  168 ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
  169 ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
  170 
  171 -- | The (fully specified) date span containing all the ledger's (filtered) transactions,
  172 -- or DateSpan Nothing Nothing if there are none.
  173 ledgerDateSpan :: Ledger -> DateSpan
  174 ledgerDateSpan l
  175     | null ts = DateSpan Nothing Nothing
  176     | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
  177     where
  178       ts = sortBy (comparing tdate) $ ledgerTransactions l
  179 
  180 -- | Convenience aliases.
  181 accountnames :: Ledger -> [AccountName]
  182 accountnames = ledgerAccountNames
  183 
  184 account :: Ledger -> AccountName -> Account
  185 account = ledgerAccount
  186 
  187 accounts :: Ledger -> [Account]
  188 accounts = ledgerAccounts
  189 
  190 topaccounts :: Ledger -> [Account]
  191 topaccounts = ledgerTopAccounts
  192 
  193 accountsmatching :: [String] -> Ledger -> [Account]
  194 accountsmatching = ledgerAccountsMatching
  195 
  196 subaccounts :: Ledger -> Account -> [Account]
  197 subaccounts = ledgerSubAccounts
  198 
  199 transactions :: Ledger -> [Transaction]
  200 transactions = ledgerTransactions
  201 
  202 commodities :: Ledger -> [Commodity]
  203 commodities = nub . rawLedgerCommodities . rawledger
  204 
  205 accounttree :: Int -> Ledger -> Tree Account
  206 accounttree = ledgerAccountTree
  207 
  208 accounttreeat :: Ledger -> Account -> Maybe (Tree Account)
  209 accounttreeat = ledgerAccountTreeAt
  210 
  211 datespan :: Ledger -> DateSpan
  212 datespan = ledgerDateSpan
  213 
  214 rawdatespan :: Ledger -> DateSpan
  215 rawdatespan = rawLedgerDateSpan . rawledger
  216 
  217 ledgeramounts :: Ledger -> [MixedAmount]
  218 ledgeramounts = rawLedgerAmounts . rawledger