The journal/timeclock/timedot parsers, instead of constructing (opaque) journal update functions which are later applied to build the journal, now construct the journal directly (by modifying the parser state). This is easier to understand and debug. It also removes any possibility of the journal updates being a space leak. (They weren't, in fact memory usage is now slightly higher, but that will be addressed in other ways.) Also: Journal data and journal parse info have been merged into one type (for now), and field names are more consistent. The ParsedJournal type alias has been added to distinguish being-parsed and finalised journals. Journal is now a monoid. stats: fixed an issue with ordering of include files journal: fixed an issue with ordering of included same-date transactions timeclock: sessions can no longer span file boundaries (unclocked-out sessions will be auto-closed at the end of the file). expandPath now throws a proper IO error (and requires the IO monad).
		
			
				
	
	
		
			100 lines
		
	
	
		
			3.6 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			100 lines
		
	
	
		
			3.6 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-|
 | |
| 
 | |
| A 'Ledger' is derived from a 'Journal' by applying a filter specification
 | |
| to select 'Transaction's and 'Posting's of interest. It contains the
 | |
| filtered journal and knows the resulting chart of accounts, account
 | |
| balances, and postings in each account.
 | |
| 
 | |
| -}
 | |
| 
 | |
| module Hledger.Data.Ledger
 | |
| where
 | |
| import qualified Data.Map as M
 | |
| import Safe (headDef)
 | |
| import Test.HUnit
 | |
| import Text.Printf
 | |
| 
 | |
| import Hledger.Data.Types
 | |
| import Hledger.Data.Account
 | |
| import Hledger.Data.Journal
 | |
| import Hledger.Data.Posting
 | |
| import Hledger.Query
 | |
| 
 | |
| 
 | |
| instance Show Ledger where
 | |
|     show l = printf "Ledger with %d transactions, %d accounts\n" --"%s"
 | |
|              (length (jtxns $ ljournal l) +
 | |
|               length (jmodifiertxns $ ljournal l) +
 | |
|               length (jperiodictxns $ ljournal l))
 | |
|              (length $ ledgerAccountNames l)
 | |
|              -- (showtree $ ledgerAccountNameTree l)
 | |
| 
 | |
| nullledger :: Ledger
 | |
| nullledger = Ledger {
 | |
|   ljournal = nulljournal,
 | |
|   laccounts = []
 | |
|   }
 | |
| 
 | |
| -- | Filter a journal's transactions with the given query, then derive
 | |
| -- a ledger containing the chart of accounts and balances. If the
 | |
| -- query includes a depth limit, that will affect the this ledger's
 | |
| -- journal but not the ledger's account tree.
 | |
| ledgerFromJournal :: Query -> Journal -> Ledger
 | |
| ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
 | |
|   where
 | |
|     (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
 | |
|     j'  = filterJournalAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude
 | |
|           filterJournalPostings q' j
 | |
|     as  = accountsFromPostings $ journalPostings j'
 | |
|     j'' = filterJournalPostings depthq j'
 | |
| 
 | |
| -- | List a ledger's account names.
 | |
| ledgerAccountNames :: Ledger -> [AccountName]
 | |
| ledgerAccountNames = drop 1 . map aname . laccounts
 | |
| 
 | |
| -- | Get the named account from a ledger.
 | |
| ledgerAccount :: Ledger -> AccountName -> Maybe Account
 | |
| ledgerAccount l a = lookupAccount a $ laccounts l
 | |
| 
 | |
| -- | Get this ledger's root account, which is a dummy "root" account
 | |
| -- above all others. This should always be first in the account list,
 | |
| -- if somehow not this returns a null account.
 | |
| ledgerRootAccount :: Ledger -> Account
 | |
| ledgerRootAccount = headDef nullacct . laccounts
 | |
| 
 | |
| -- | List a ledger's top-level accounts (the ones below the root), in tree order.
 | |
| ledgerTopAccounts :: Ledger -> [Account]
 | |
| ledgerTopAccounts = asubs . head . laccounts
 | |
| 
 | |
| -- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
 | |
| ledgerLeafAccounts :: Ledger -> [Account]
 | |
| ledgerLeafAccounts = filter (null.asubs) . laccounts
 | |
| 
 | |
| -- | Accounts in ledger whose name matches the pattern, in tree order.
 | |
| ledgerAccountsMatching :: [String] -> Ledger -> [Account]
 | |
| ledgerAccountsMatching pats = filter (matchpats pats . aname) . laccounts
 | |
| 
 | |
| -- | List a ledger's postings, in the order parsed.
 | |
| ledgerPostings :: Ledger -> [Posting]
 | |
| ledgerPostings = journalPostings . ljournal
 | |
| 
 | |
| -- | The (fully specified) date span containing all the ledger's (filtered) transactions,
 | |
| -- or DateSpan Nothing Nothing if there are none.
 | |
| ledgerDateSpan :: Ledger -> DateSpan
 | |
| ledgerDateSpan = postingsDateSpan . ledgerPostings
 | |
| 
 | |
| -- | All commodities used in this ledger.
 | |
| ledgerCommodities :: Ledger -> [CommoditySymbol]
 | |
| ledgerCommodities = M.keys . jinferredcommodities . ljournal
 | |
| 
 | |
| 
 | |
| tests_ledgerFromJournal = [
 | |
|  "ledgerFromJournal" ~: do
 | |
|   assertEqual "" (0) (length $ ledgerPostings $ ledgerFromJournal Any nulljournal)
 | |
|   assertEqual "" (11) (length $ ledgerPostings $ ledgerFromJournal Any samplejournal)
 | |
|   assertEqual "" (6) (length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal)
 | |
|  ]
 | |
| 
 | |
| tests_Hledger_Data_Ledger = TestList $
 | |
|     tests_ledgerFromJournal
 |