The first of several conversions from String to (strict) Text, hopefully reducing space and time usage. This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1: hledger -f data/100x100x10.journal stats string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>> text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>> hledger -f data/1000x100x10.journal stats string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>> text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>> hledger -f data/10000x100x10.journal stats string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>> text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>> hledger -f data/100000x100x10.journal stats string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>> text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
		
			
				
	
	
		
			102 lines
		
	
	
		
			3.7 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			102 lines
		
	
	
		
			3.7 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 Data.Text (Text)
 | |
| import qualified Data.Text as T
 | |
| 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 . T.unpack . aname) . laccounts -- XXX pack
 | |
| 
 | |
| -- | 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
 |