remove dead code, simplify cacheLedger again
This commit is contained in:
parent
ce3eeb80b6
commit
01cd388c24
@ -32,11 +32,10 @@ instance Show Ledger where
|
|||||||
(length $ accountnames l)
|
(length $ accountnames l)
|
||||||
(show $ accountnames l)
|
(show $ accountnames l)
|
||||||
++ "\n" ++ (showtree $ accountnametree l)
|
++ "\n" ++ (showtree $ accountnametree l)
|
||||||
++ "\n" ++ (showtree $ filteredaccountnametree l)
|
|
||||||
|
|
||||||
-- | Convert a raw ledger to a more efficient cached type, described above.
|
-- | Convert a raw ledger to a more efficient cached type, described above.
|
||||||
cacheLedger :: Regex -> RawLedger -> Ledger
|
cacheLedger :: RawLedger -> Ledger
|
||||||
cacheLedger acctpat l =
|
cacheLedger l =
|
||||||
let
|
let
|
||||||
ant = rawLedgerAccountNameTree l
|
ant = rawLedgerAccountNameTree l
|
||||||
anames = flatten ant
|
anames = flatten ant
|
||||||
@ -53,46 +52,18 @@ cacheLedger acctpat l =
|
|||||||
(Map.fromList [(a, (sumTransactions $ subtxnsof a){precision=maxprecision}) | a <- anames])
|
(Map.fromList [(a, (sumTransactions $ subtxnsof a){precision=maxprecision}) | a <- anames])
|
||||||
(Map.fromList [(a,nullamt) | a <- anames])
|
(Map.fromList [(a,nullamt) | a <- anames])
|
||||||
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
||||||
-- the same again, considering only accounts and transactions matching the account pattern
|
|
||||||
matchacct :: AccountName -> Bool
|
|
||||||
matchacct = containsRegex acctpat . accountLeafName
|
|
||||||
filteredant = treefilter matchacct ant
|
|
||||||
-- rebuild the tree after filtering to include all parents
|
|
||||||
filteredanames = flatten $ accountNameTreeFrom $ filter matchacct anames
|
|
||||||
filteredts = filter (matchacct . account) ts
|
|
||||||
filteredsortedts = sortBy (comparing account) filteredts
|
|
||||||
filteredgroupedts = groupBy (\t1 t2 -> account t1 == account t2) filteredsortedts
|
|
||||||
filteredtxnmap = Map.union
|
|
||||||
(Map.fromList [(account $ head g, g) | g <- filteredgroupedts])
|
|
||||||
(Map.fromList [(a,[]) | a <- filteredanames])
|
|
||||||
filteredtxnsof = (filteredtxnmap !)
|
|
||||||
filteredsubacctsof a = filter (isAccountNamePrefixOf a) filteredanames
|
|
||||||
filteredsubtxnsof a = concat [filteredtxnsof a | a <- [a] ++ filteredsubacctsof a]
|
|
||||||
filteredbalmap = Map.union
|
|
||||||
(Map.fromList [(a, (sumTransactions $ filteredsubtxnsof a){precision=maxprecision}) | a <- filteredanames])
|
|
||||||
(Map.fromList [(a,nullamt) | a <- filteredanames])
|
|
||||||
filteredamap = Map.fromList [(a, Account a (filteredtxnmap ! a) (filteredbalmap ! a)) | a <- filteredanames]
|
|
||||||
|
|
||||||
maxprecision = maximum $ map (precision . amount) ts
|
maxprecision = maximum $ map (precision . amount) ts
|
||||||
in
|
in
|
||||||
Ledger l ant amap maxprecision acctpat filteredant filteredamap
|
Ledger l ant amap maxprecision
|
||||||
|
|
||||||
-- | List a 'Ledger' 's account names.
|
-- | List a 'Ledger' 's account names.
|
||||||
accountnames :: Ledger -> [AccountName]
|
accountnames :: Ledger -> [AccountName]
|
||||||
accountnames l = drop 1 $ flatten $ accountnametree l
|
accountnames l = drop 1 $ flatten $ accountnametree l
|
||||||
|
|
||||||
-- | List a 'Ledger' 's account names filtered by the account match pattern.
|
|
||||||
filteredaccountnames :: Ledger -> [AccountName]
|
|
||||||
filteredaccountnames l = filter (containsRegex (acctpat l) . accountLeafName) $ accountnames l
|
|
||||||
|
|
||||||
-- | Get the named account from a ledger.
|
-- | Get the named account from a ledger.
|
||||||
ledgerAccount :: Ledger -> AccountName -> Account
|
ledgerAccount :: Ledger -> AccountName -> Account
|
||||||
ledgerAccount l a = (accountmap l) ! a
|
ledgerAccount l a = (accountmap l) ! a
|
||||||
|
|
||||||
-- | Get the named filtered account from a ledger.
|
|
||||||
ledgerFilteredAccount :: Ledger -> AccountName -> Account
|
|
||||||
ledgerFilteredAccount l a = (filteredaccountmap l) ! a
|
|
||||||
|
|
||||||
-- | List a ledger's accounts, in tree order
|
-- | List a ledger's accounts, in tree order
|
||||||
accounts :: Ledger -> [Account]
|
accounts :: Ledger -> [Account]
|
||||||
accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
|
accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
|
||||||
@ -141,19 +112,8 @@ instance Eq Account where
|
|||||||
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
||||||
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
||||||
|
|
||||||
-- | Get a ledger's tree of accounts to the specified depth, filtered by
|
|
||||||
-- the account pattern.
|
|
||||||
ledgerFilteredAccountTree :: Int -> Regex -> Ledger -> Tree Account
|
|
||||||
ledgerFilteredAccountTree depth acctpat l =
|
|
||||||
addFilteredDataToAccountNameTree l $ treeprune depth $ filteredaccountnametree l
|
|
||||||
|
|
||||||
-- | Convert a tree of account names into a tree of accounts, using their
|
-- | Convert a tree of account names into a tree of accounts, using their
|
||||||
-- parent ledger.
|
-- parent ledger.
|
||||||
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
||||||
addDataToAccountNameTree = treemap . ledgerAccount
|
addDataToAccountNameTree = treemap . ledgerAccount
|
||||||
|
|
||||||
-- | Convert a tree of account names into a tree of accounts, using their
|
|
||||||
-- parent ledger's filtered account data.
|
|
||||||
addFilteredDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
|
||||||
addFilteredDataToAccountNameTree l = treemap (ledgerFilteredAccount l)
|
|
||||||
|
|
||||||
|
|||||||
@ -44,8 +44,8 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
|
|||||||
-- | Remove ledger entries we are not interested in.
|
-- | Remove ledger entries we are not interested in.
|
||||||
-- Keep only those which fall between the begin and end dates, and match
|
-- Keep only those which fall between the begin and end dates, and match
|
||||||
-- the description pattern.
|
-- the description pattern.
|
||||||
filterRawLedgerEntries :: String -> String -> Regex -> RawLedger -> RawLedger
|
filterRawLedger :: String -> String -> Regex -> RawLedger -> RawLedger
|
||||||
filterRawLedgerEntries begin end descpat =
|
filterRawLedger begin end descpat =
|
||||||
filterRawLedgerEntriesByDate begin end .
|
filterRawLedgerEntriesByDate begin end .
|
||||||
filterRawLedgerEntriesByDescription descpat
|
filterRawLedgerEntriesByDescription descpat
|
||||||
|
|
||||||
|
|||||||
@ -91,9 +91,6 @@ data Ledger = Ledger {
|
|||||||
rawledger :: RawLedger,
|
rawledger :: RawLedger,
|
||||||
accountnametree :: Tree AccountName,
|
accountnametree :: Tree AccountName,
|
||||||
accountmap :: Map.Map AccountName Account,
|
accountmap :: Map.Map AccountName Account,
|
||||||
lprecision :: Int, -- the preferred display precision
|
lprecision :: Int -- the preferred display precision
|
||||||
acctpat :: Regex, -- the account patterns used to filter this ledger
|
|
||||||
filteredaccountnametree :: Tree AccountName, -- account name tree filtered by acctpat
|
|
||||||
filteredaccountmap :: Map.Map AccountName Account -- accounts filtered by acctpat
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
27
Tests.hs
27
Tests.hs
@ -84,19 +84,11 @@ tests =
|
|||||||
(accountnames ledger7)
|
(accountnames ledger7)
|
||||||
|
|
||||||
,"cacheLedger" ~: do
|
,"cacheLedger" ~: do
|
||||||
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger wildcard rawledger7 )
|
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7 )
|
||||||
|
|
||||||
-- ,"showLedgerAccounts" ~: do
|
|
||||||
-- assertequal 4 (length $ lines $ showLedgerAccountBalances ledger7 1)
|
|
||||||
|
|
||||||
,"ledgeramount" ~: do
|
,"ledgeramount" ~: do
|
||||||
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
|
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
|
||||||
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
|
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
|
||||||
|
|
||||||
-- ,"pruneZeroBalanceLeaves" ~: do
|
|
||||||
-- atree <- liftM (ledgerAccountTree 99) $ ledgerfromfile "sample.ledger"
|
|
||||||
-- assertequal 13 (length $ flatten $ atree)
|
|
||||||
-- assertequal 12 (length $ flatten $ pruneZeroBalanceLeaves $ atree)
|
|
||||||
]
|
]
|
||||||
|
|
||||||
balancecommandtests =
|
balancecommandtests =
|
||||||
@ -131,8 +123,7 @@ balancecommandtests =
|
|||||||
,
|
,
|
||||||
|
|
||||||
"balance report with account pattern o" ~: do
|
"balance report with account pattern o" ~: do
|
||||||
rl <- rawledgerfromfile "sample.ledger"
|
l <- ledgerfromfile "sample.ledger"
|
||||||
let l = cacheLedger (mkRegex "o") $ filterRawLedgerEntries "" "" wildcard rl
|
|
||||||
assertequal
|
assertequal
|
||||||
" $1 expenses:food\n\
|
" $1 expenses:food\n\
|
||||||
\ $-2 income\n\
|
\ $-2 income\n\
|
||||||
@ -143,8 +134,7 @@ balancecommandtests =
|
|||||||
,
|
,
|
||||||
|
|
||||||
"balance report with account pattern o and showsubs" ~: do
|
"balance report with account pattern o and showsubs" ~: do
|
||||||
rl <- rawledgerfromfile "sample.ledger"
|
l <- ledgerfromfile "sample.ledger"
|
||||||
let l = cacheLedger (mkRegex "o") $ filterRawLedgerEntries "" "" wildcard rl
|
|
||||||
assertequal
|
assertequal
|
||||||
" $1 expenses:food\n\
|
" $1 expenses:food\n\
|
||||||
\ $-2 income\n\
|
\ $-2 income\n\
|
||||||
@ -157,8 +147,7 @@ balancecommandtests =
|
|||||||
,
|
,
|
||||||
|
|
||||||
"balance report with account pattern a" ~: do
|
"balance report with account pattern a" ~: do
|
||||||
rl <- rawledgerfromfile "sample.ledger"
|
l <- ledgerfromfile "sample.ledger"
|
||||||
let l = cacheLedger (mkRegex "a") $ filterRawLedgerEntries "" "" wildcard rl
|
|
||||||
assertequal
|
assertequal
|
||||||
" $-1 assets\n\
|
" $-1 assets\n\
|
||||||
\ $-2 cash\n\
|
\ $-2 cash\n\
|
||||||
@ -172,8 +161,7 @@ balancecommandtests =
|
|||||||
,
|
,
|
||||||
|
|
||||||
"balance report with account pattern e" ~: do
|
"balance report with account pattern e" ~: do
|
||||||
rl <- rawledgerfromfile "sample.ledger"
|
l <- ledgerfromfile "sample.ledger"
|
||||||
let l = cacheLedger (mkRegex "e") $ filterRawLedgerEntries "" "" wildcard rl
|
|
||||||
assertequal
|
assertequal
|
||||||
" $-1 assets\n\
|
" $-1 assets\n\
|
||||||
\ $2 expenses\n\
|
\ $2 expenses\n\
|
||||||
@ -185,8 +173,7 @@ balancecommandtests =
|
|||||||
,
|
,
|
||||||
|
|
||||||
"balance report with unmatched parent of two matched subaccounts" ~: do
|
"balance report with unmatched parent of two matched subaccounts" ~: do
|
||||||
rl <- rawledgerfromfile "sample.ledger"
|
l <- ledgerfromfile "sample.ledger"
|
||||||
let l = cacheLedger (regexFor ["cash","saving"]) $ filterRawLedgerEntries "" "" wildcard rl
|
|
||||||
assertequal
|
assertequal
|
||||||
" $-2 assets:cash\n\
|
" $-2 assets:cash\n\
|
||||||
\ $1 assets:saving\n\
|
\ $1 assets:saving\n\
|
||||||
@ -479,7 +466,7 @@ rawledger7 = RawLedger
|
|||||||
]
|
]
|
||||||
""
|
""
|
||||||
|
|
||||||
ledger7 = cacheLedger wildcard rawledger7
|
ledger7 = cacheLedger rawledger7
|
||||||
|
|
||||||
timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"
|
timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"
|
||||||
timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
|
timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
|
||||||
|
|||||||
4
Utils.hs
4
Utils.hs
@ -37,7 +37,7 @@ rawledgerfromfile f = do
|
|||||||
ledgerfromfile :: FilePath -> IO Ledger
|
ledgerfromfile :: FilePath -> IO Ledger
|
||||||
ledgerfromfile f = do
|
ledgerfromfile f = do
|
||||||
l <- rawledgerfromfile f
|
l <- rawledgerfromfile f
|
||||||
return $ cacheLedger wildcard $ filterRawLedgerEntries "" "" wildcard l
|
return $ cacheLedger $ filterRawLedger "" "" wildcard l
|
||||||
|
|
||||||
-- | get a RawLedger from the file your LEDGER environment variable
|
-- | get a RawLedger from the file your LEDGER environment variable
|
||||||
-- variable points to or (WARNING) an empty one if there was a problem.
|
-- variable points to or (WARNING) an empty one if there was a problem.
|
||||||
@ -51,7 +51,7 @@ myrawledger = do
|
|||||||
myledger :: IO Ledger
|
myledger :: IO Ledger
|
||||||
myledger = do
|
myledger = do
|
||||||
l <- myrawledger
|
l <- myrawledger
|
||||||
return $ cacheLedger wildcard $ filterRawLedgerEntries "" "" wildcard l
|
return $ cacheLedger $ filterRawLedger "" "" wildcard l
|
||||||
|
|
||||||
-- | get a named account from your ledger file
|
-- | get a named account from your ledger file
|
||||||
myaccount :: AccountName -> IO Account
|
myaccount :: AccountName -> IO Account
|
||||||
|
|||||||
@ -44,7 +44,7 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ())
|
|||||||
parseLedgerAndDo opts args cmd =
|
parseLedgerAndDo opts args cmd =
|
||||||
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
|
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
|
||||||
where
|
where
|
||||||
runthecommand = cmd opts args . cacheLedger acctpat . filterRawLedgerEntries begin end descpat
|
runthecommand = cmd opts args . cacheLedger . filterRawLedger begin end descpat
|
||||||
begin = beginDateFromOpts opts
|
begin = beginDateFromOpts opts
|
||||||
end = endDateFromOpts opts
|
end = endDateFromOpts opts
|
||||||
acctpat = regexFor acctpats
|
acctpat = regexFor acctpats
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user