balance report speedup
This refactoring fixes an O(n^2) slowdown in the balance command with
large numbers of accounts. It's now speedy, and the implementation is
clearer. To facilitate this, the Account type now represents a tree of
accounts which can easily be traversed up or down (and/or flattened
into a list).
Benchmark on a 2010 macbook:
+-------------------------------------------++--------------+------------+--------+
| || before: | after: | |
| || hledger-0.18 | hledgeropt | ledger |
+===========================================++==============+============+========+
| -f data/100x100x10.journal balance || 0.21 | 0.07 | 0.09 |
| -f data/1000x1000x10.journal balance || 10.13 | 0.47 | 0.62 |
| -f data/1000x10000x10.journal balance || 40.67 | 0.67 | 1.01 |
| -f data/10000x1000x10.journal balance || 15.01 | 3.22 | 2.36 |
| -f data/10000x1000x10.journal balance aa || 4.77 | 4.40 | 2.33 |
+-------------------------------------------++--------------+------------+--------+
This commit is contained in:
Simon Michael
parent
cb2a4e543f
commit
00f22819ae
@ -1,31 +1,166 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards, StandaloneDeriving #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
An 'Account' stores
|
|
||||||
|
|
||||||
- an 'AccountName',
|
An 'Account' has a name, a list of subaccounts, an optional parent
|
||||||
|
account, and subaccounting-excluding and -including balances.
|
||||||
- all 'Posting's in the account, excluding subaccounts
|
|
||||||
|
|
||||||
- a 'MixedAmount' representing the account balance, including subaccounts.
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Data.Account
|
module Hledger.Data.Account
|
||||||
where
|
where
|
||||||
|
import Data.List
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Safe (headMay, lookupJustDef)
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
|
||||||
|
import Hledger.Data.AccountName
|
||||||
import Hledger.Data.Amount
|
import Hledger.Data.Amount
|
||||||
|
import Hledger.Data.Posting()
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
|
import Hledger.Utils
|
||||||
|
|
||||||
|
|
||||||
|
-- deriving instance Show Account
|
||||||
instance Show Account where
|
instance Show Account where
|
||||||
show (Account a ps b) = printf "Account %s with %d postings and %s balance" a (length ps) (showMixedAmountDebug b)
|
show Account{..} = printf "Account %s (boring:%s, ebalance:%s, ibalance:%s)"
|
||||||
|
aname
|
||||||
|
(if aboring then "y" else "n")
|
||||||
|
(showMixedAmount aebalance)
|
||||||
|
(showMixedAmount aibalance)
|
||||||
|
|
||||||
instance Eq Account where
|
instance Eq Account where
|
||||||
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
|
(==) a b = aname a == aname b -- quick equality test for speed
|
||||||
|
-- and
|
||||||
|
-- [ aname a == aname b
|
||||||
|
-- -- , aparent a == aparent b -- avoid infinite recursion
|
||||||
|
-- , asubs a == asubs b
|
||||||
|
-- , aebalance a == aebalance b
|
||||||
|
-- , aibalance a == aibalance b
|
||||||
|
-- ]
|
||||||
|
|
||||||
|
nullacct = Account
|
||||||
|
{ aname = ""
|
||||||
|
, aparent = Nothing
|
||||||
|
, asubs = []
|
||||||
|
, aebalance = nullmixedamt
|
||||||
|
, aibalance = nullmixedamt
|
||||||
|
, aboring = False
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Derive an account tree with balances from a set of postings.
|
||||||
|
-- (*ledger's core feature.) The accounts are returned in a list, but
|
||||||
|
-- retain their tree structure; the first one is the root of the tree.
|
||||||
|
accountsFromPostings :: [Posting] -> [Account]
|
||||||
|
accountsFromPostings ps =
|
||||||
|
let
|
||||||
|
acctamts = [(paccount p,pamount p) | p <- ps]
|
||||||
|
grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts
|
||||||
|
summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty
|
||||||
|
setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}
|
||||||
|
nametree = treeFromPaths $ map (expandAccountName . fst) summed
|
||||||
|
acctswithnames = nameTreeToAccount "root" nametree
|
||||||
|
acctswithebals = mapAccounts setebalance acctswithnames
|
||||||
|
acctswithibals = sumAccounts acctswithebals
|
||||||
|
acctswithparents = tieAccountParents acctswithibals
|
||||||
|
acctsflattened = flattenAccounts acctswithparents
|
||||||
|
in
|
||||||
|
acctsflattened
|
||||||
|
|
||||||
|
-- | Convert an AccountName tree to an Account tree
|
||||||
|
nameTreeToAccount :: AccountName -> FastTree AccountName -> Account
|
||||||
|
nameTreeToAccount rootname (T m) =
|
||||||
|
nullacct{ aname=rootname, asubs=map (uncurry nameTreeToAccount) $ M.assocs m }
|
||||||
|
|
||||||
|
-- | Tie the knot so all subaccounts' parents are set correctly.
|
||||||
|
tieAccountParents :: Account -> Account
|
||||||
|
tieAccountParents = tie Nothing
|
||||||
|
where
|
||||||
|
tie parent a@Account{..} = a'
|
||||||
|
where
|
||||||
|
a' = a{aparent=parent, asubs=map (tie (Just a')) asubs}
|
||||||
|
|
||||||
|
-- | Get this account's parent accounts, from the nearest up to the root.
|
||||||
|
parentAccounts :: Account -> [Account]
|
||||||
|
parentAccounts Account{aparent=Nothing} = []
|
||||||
|
parentAccounts Account{aparent=Just a} = a:parentAccounts a
|
||||||
|
|
||||||
|
-- | List the accounts at each level of the account tree.
|
||||||
|
accountsLevels :: Account -> [[Account]]
|
||||||
|
accountsLevels = takeWhile (not . null) . iterate (concatMap asubs) . (:[])
|
||||||
|
|
||||||
|
-- | Map a (non-tree-structure-modifying) function over this and sub accounts.
|
||||||
|
mapAccounts :: (Account -> Account) -> Account -> Account
|
||||||
|
mapAccounts f a = f a{asubs = map (mapAccounts f) $ asubs a}
|
||||||
|
|
||||||
|
-- | Is the predicate true on any of this account or its subaccounts ?
|
||||||
|
anyAccounts :: (Account -> Bool) -> Account -> Bool
|
||||||
|
anyAccounts p a
|
||||||
|
| p a = True
|
||||||
|
| otherwise = any (anyAccounts p) $ asubs a
|
||||||
|
|
||||||
|
-- | Add subaccount-inclusive balances to an account tree.
|
||||||
|
-- -- , also noting
|
||||||
|
-- -- whether it has an interesting balance or interesting subs to help
|
||||||
|
-- -- with eliding later.
|
||||||
|
sumAccounts :: Account -> Account
|
||||||
|
sumAccounts a
|
||||||
|
| null $ asubs a = a{aibalance=aebalance a}
|
||||||
|
| otherwise = a{aibalance=ibal, asubs=subs}
|
||||||
|
where
|
||||||
|
subs = map sumAccounts $ asubs a
|
||||||
|
ibal = sum $ aebalance a : map aibalance subs
|
||||||
|
|
||||||
|
-- | Remove all subaccounts below a certain depth.
|
||||||
|
clipAccounts :: Int -> Account -> Account
|
||||||
|
clipAccounts 0 a = a{asubs=[]}
|
||||||
|
clipAccounts d a = a{asubs=subs}
|
||||||
|
where
|
||||||
|
subs = map (clipAccounts (d-1)) $ asubs a
|
||||||
|
|
||||||
|
-- | Remove all leaf accounts and subtrees matching a predicate.
|
||||||
|
pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account
|
||||||
|
pruneAccounts p = headMay . prune
|
||||||
|
where
|
||||||
|
prune a
|
||||||
|
| null prunedsubs = if p a then [] else [a]
|
||||||
|
| otherwise = [a{asubs=prunedsubs}]
|
||||||
|
where
|
||||||
|
prunedsubs = concatMap prune $ asubs a
|
||||||
|
|
||||||
|
-- | Flatten an account tree into a list, which is sometimes
|
||||||
|
-- convenient. Note since accounts link to their parents/subs, the
|
||||||
|
-- account tree remains intact and can still be used. It's a tree/list!
|
||||||
|
flattenAccounts :: Account -> [Account]
|
||||||
|
flattenAccounts a = squish a []
|
||||||
|
where squish a as = a:Prelude.foldr squish as (asubs a)
|
||||||
|
|
||||||
|
-- | Filter an account tree (to a list).
|
||||||
|
filterAccounts :: (Account -> Bool) -> Account -> [Account]
|
||||||
|
filterAccounts p a
|
||||||
|
| p a = a : concatMap (filterAccounts p) (asubs a)
|
||||||
|
| otherwise = concatMap (filterAccounts p) (asubs a)
|
||||||
|
|
||||||
|
-- | Search an account list by name.
|
||||||
|
lookupAccount :: AccountName -> [Account] -> Maybe Account
|
||||||
|
lookupAccount a = find ((==a).aname)
|
||||||
|
|
||||||
|
-- debug helpers
|
||||||
|
|
||||||
|
printAccounts :: Account -> IO ()
|
||||||
|
printAccounts = putStrLn . showAccounts
|
||||||
|
|
||||||
|
showAccounts = unlines . map showAccountDebug . flattenAccounts
|
||||||
|
|
||||||
|
showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
|
||||||
|
|
||||||
|
showAccountDebug a = printf "%-25s %4s %4s %s"
|
||||||
|
(aname a)
|
||||||
|
(showMixedAmount $ aebalance a)
|
||||||
|
(showMixedAmount $ aibalance a)
|
||||||
|
(if aboring a then "b" else " ")
|
||||||
|
|
||||||
nullacct = Account "" [] nullmixedamt
|
|
||||||
|
|
||||||
tests_Hledger_Data_Account = TestList [
|
tests_Hledger_Data_Account = TestList [
|
||||||
]
|
]
|
||||||
|
|||||||
@ -10,11 +10,9 @@ hierarchy.
|
|||||||
module Hledger.Data.AccountName
|
module Hledger.Data.AccountName
|
||||||
where
|
where
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Map (Map)
|
|
||||||
import Data.Tree
|
import Data.Tree
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import qualified Data.Map as M
|
|
||||||
|
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
@ -42,8 +40,11 @@ accountNameDrop n = accountNameFromComponents . drop n . accountNameComponents
|
|||||||
|
|
||||||
-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
|
-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
|
||||||
expandAccountNames :: [AccountName] -> [AccountName]
|
expandAccountNames :: [AccountName] -> [AccountName]
|
||||||
expandAccountNames as = nub $ concatMap expand as
|
expandAccountNames as = nub $ concatMap expandAccountName as
|
||||||
where expand = map accountNameFromComponents . tail . inits . accountNameComponents
|
|
||||||
|
-- | "a:b:c" -> ["a","a:b","a:b:c"]
|
||||||
|
expandAccountName :: AccountName -> [AccountName]
|
||||||
|
expandAccountName = map accountNameFromComponents . tail . inits . accountNameComponents
|
||||||
|
|
||||||
-- | ["a:b:c","d:e"] -> ["a","d"]
|
-- | ["a:b:c","d:e"] -> ["a","d"]
|
||||||
topAccountNames :: [AccountName] -> [AccountName]
|
topAccountNames :: [AccountName] -> [AccountName]
|
||||||
@ -72,83 +73,15 @@ subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts
|
|||||||
|
|
||||||
-- | Convert a list of account names to a tree.
|
-- | Convert a list of account names to a tree.
|
||||||
accountNameTreeFrom :: [AccountName] -> Tree AccountName
|
accountNameTreeFrom :: [AccountName] -> Tree AccountName
|
||||||
accountNameTreeFrom = accountNameTreeFrom1
|
accountNameTreeFrom accts =
|
||||||
|
Node "root" (accounttreesfrom (topAccountNames accts))
|
||||||
accountNameTreeFrom1 accts =
|
|
||||||
Node "top" (accounttreesfrom (topAccountNames accts))
|
|
||||||
where
|
where
|
||||||
accounttreesfrom :: [AccountName] -> [Tree AccountName]
|
accounttreesfrom :: [AccountName] -> [Tree AccountName]
|
||||||
accounttreesfrom [] = []
|
accounttreesfrom [] = []
|
||||||
accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as]
|
accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as]
|
||||||
subs = subAccountNamesFrom (expandAccountNames accts)
|
subs = subAccountNamesFrom (expandAccountNames accts)
|
||||||
|
|
||||||
nullaccountnametree = Node "top" []
|
nullaccountnametree = Node "root" []
|
||||||
|
|
||||||
accountNameTreeFrom2 accts =
|
|
||||||
Node "top" $ unfoldForest (\a -> (a, subs a)) $ topAccountNames accts
|
|
||||||
where
|
|
||||||
subs = subAccountNamesFrom allaccts
|
|
||||||
allaccts = expandAccountNames accts
|
|
||||||
-- subs' a = subsmap ! a
|
|
||||||
-- subsmap :: Map AccountName [AccountName]
|
|
||||||
-- subsmap = Data.Map.fromList [(a, subAccountNamesFrom allaccts a) | a <- allaccts]
|
|
||||||
|
|
||||||
accountNameTreeFrom3 accts =
|
|
||||||
Node "top" $ forestfrom allaccts $ topAccountNames accts
|
|
||||||
where
|
|
||||||
-- drop accts from the list of potential subs as we add them to the tree
|
|
||||||
forestfrom :: [AccountName] -> [AccountName] -> Forest AccountName
|
|
||||||
forestfrom subaccts accts =
|
|
||||||
[let subaccts' = subaccts \\ accts in Node a $ forestfrom subaccts' (subAccountNamesFrom subaccts' a) | a <- accts]
|
|
||||||
allaccts = expandAccountNames accts
|
|
||||||
|
|
||||||
|
|
||||||
-- a more efficient tree builder from Cale Gibbard
|
|
||||||
newtype Tree' a = T (Map a (Tree' a))
|
|
||||||
deriving (Show, Eq, Ord)
|
|
||||||
|
|
||||||
mergeTrees :: (Ord a) => Tree' a -> Tree' a -> Tree' a
|
|
||||||
mergeTrees (T m) (T m') = T (M.unionWith mergeTrees m m')
|
|
||||||
|
|
||||||
emptyTree = T M.empty
|
|
||||||
|
|
||||||
pathtree :: [a] -> Tree' a
|
|
||||||
pathtree [] = T M.empty
|
|
||||||
pathtree (x:xs) = T (M.singleton x (pathtree xs))
|
|
||||||
|
|
||||||
fromPaths :: (Ord a) => [[a]] -> Tree' a
|
|
||||||
fromPaths = foldl' mergeTrees emptyTree . map pathtree
|
|
||||||
|
|
||||||
-- the above, but trying to build Tree directly
|
|
||||||
|
|
||||||
-- mergeTrees' :: (Ord a) => Tree a -> Tree a -> Tree a
|
|
||||||
-- mergeTrees' (Node m ms) (Node m' ms') = Node undefined (ms `union` ms')
|
|
||||||
|
|
||||||
-- emptyTree' = Node "top" []
|
|
||||||
|
|
||||||
-- pathtree' :: [a] -> Tree a
|
|
||||||
-- pathtree' [] = Node undefined []
|
|
||||||
-- pathtree' (x:xs) = Node x [pathtree' xs]
|
|
||||||
|
|
||||||
-- fromPaths' :: (Ord a) => [[a]] -> Tree a
|
|
||||||
-- fromPaths' = foldl' mergeTrees' emptyTree' . map pathtree'
|
|
||||||
|
|
||||||
|
|
||||||
-- converttree :: [AccountName] -> Tree' AccountName -> [Tree AccountName]
|
|
||||||
-- converttree parents (T m) = [Node (accountNameFromComponents $ parents ++ [a]) (converttree (parents++[a]) b) | (a,b) <- M.toList m]
|
|
||||||
|
|
||||||
-- accountNameTreeFrom4 :: [AccountName] -> Tree AccountName
|
|
||||||
-- accountNameTreeFrom4 accts = Node "top" (converttree [] $ fromPaths $ map accountNameComponents accts)
|
|
||||||
|
|
||||||
converttree :: Tree' AccountName -> [Tree AccountName]
|
|
||||||
converttree (T m) = [Node a (converttree b) | (a,b) <- M.toList m]
|
|
||||||
|
|
||||||
expandTreeNames :: Tree AccountName -> Tree AccountName
|
|
||||||
expandTreeNames (Node x ts) = Node x (map (treemap (\n -> accountNameFromComponents [x,n]) . expandTreeNames) ts)
|
|
||||||
|
|
||||||
accountNameTreeFrom4 :: [AccountName] -> Tree AccountName
|
|
||||||
accountNameTreeFrom4 = Node "top" . map expandTreeNames . converttree . fromPaths . map accountNameComponents
|
|
||||||
|
|
||||||
|
|
||||||
-- | Elide an account name to fit in the specified width.
|
-- | Elide an account name to fit in the specified width.
|
||||||
-- From the ledger 2.6 news:
|
-- From the ledger 2.6 news:
|
||||||
@ -199,10 +132,10 @@ isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
|
|||||||
tests_Hledger_Data_AccountName = TestList
|
tests_Hledger_Data_AccountName = TestList
|
||||||
[
|
[
|
||||||
"accountNameTreeFrom" ~: do
|
"accountNameTreeFrom" ~: do
|
||||||
accountNameTreeFrom ["a"] `is` Node "top" [Node "a" []]
|
accountNameTreeFrom ["a"] `is` Node "root" [Node "a" []]
|
||||||
accountNameTreeFrom ["a","b"] `is` Node "top" [Node "a" [], Node "b" []]
|
accountNameTreeFrom ["a","b"] `is` Node "root" [Node "a" [], Node "b" []]
|
||||||
accountNameTreeFrom ["a","a:b"] `is` Node "top" [Node "a" [Node "a:b" []]]
|
accountNameTreeFrom ["a","a:b"] `is` Node "root" [Node "a" [Node "a:b" []]]
|
||||||
accountNameTreeFrom ["a:b:c"] `is` Node "top" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
|
accountNameTreeFrom ["a:b:c"] `is` Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
|
||||||
|
|
||||||
,"expandAccountNames" ~:
|
,"expandAccountNames" ~:
|
||||||
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
|
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
|
||||||
|
|||||||
@ -23,7 +23,6 @@ module Hledger.Data.Journal (
|
|||||||
filterJournalPostings,
|
filterJournalPostings,
|
||||||
filterJournalTransactions,
|
filterJournalTransactions,
|
||||||
-- * Querying
|
-- * Querying
|
||||||
journalAccountInfo,
|
|
||||||
journalAccountNames,
|
journalAccountNames,
|
||||||
journalAccountNamesUsed,
|
journalAccountNamesUsed,
|
||||||
journalAmountAndPriceCommodities,
|
journalAmountAndPriceCommodities,
|
||||||
@ -43,7 +42,6 @@ module Hledger.Data.Journal (
|
|||||||
journalEquityAccountQuery,
|
journalEquityAccountQuery,
|
||||||
journalCashAccountQuery,
|
journalCashAccountQuery,
|
||||||
-- * Misc
|
-- * Misc
|
||||||
groupPostings,
|
|
||||||
matchpats,
|
matchpats,
|
||||||
nullctx,
|
nullctx,
|
||||||
nulljournal,
|
nulljournal,
|
||||||
@ -53,7 +51,7 @@ module Hledger.Data.Journal (
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Map (findWithDefault, (!), toAscList)
|
import Data.Map (findWithDefault)
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime
|
||||||
@ -67,7 +65,6 @@ import qualified Data.Map as Map
|
|||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
import Hledger.Data.AccountName
|
import Hledger.Data.AccountName
|
||||||
import Hledger.Data.Account()
|
|
||||||
import Hledger.Data.Amount
|
import Hledger.Data.Amount
|
||||||
import Hledger.Data.Commodity
|
import Hledger.Data.Commodity
|
||||||
import Hledger.Data.Dates
|
import Hledger.Data.Dates
|
||||||
@ -477,209 +474,6 @@ isnegativepat = (negateprefix `isPrefixOf`)
|
|||||||
|
|
||||||
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
|
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
|
||||||
|
|
||||||
-- | Calculate the account tree and all account balances from a journal's
|
|
||||||
-- postings, returning the results for efficient lookup.
|
|
||||||
journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account)
|
|
||||||
journalAccountInfo j = (ant, amap)
|
|
||||||
where
|
|
||||||
(ant, psof, _, inclbalof) = (groupPostings . journalPostings) j
|
|
||||||
amap = Map.fromList [(a, acctinfo a) | a <- flatten ant]
|
|
||||||
acctinfo a = Account a (psof a) (inclbalof a)
|
|
||||||
|
|
||||||
tests_journalAccountInfo = [
|
|
||||||
"journalAccountInfo" ~: do
|
|
||||||
let (t,m) = journalAccountInfo samplejournal
|
|
||||||
assertEqual "account tree"
|
|
||||||
(Node "top" [
|
|
||||||
Node "assets" [
|
|
||||||
Node "assets:bank" [
|
|
||||||
Node "assets:bank:checking" [],
|
|
||||||
Node "assets:bank:saving" []
|
|
||||||
],
|
|
||||||
Node "assets:cash" []
|
|
||||||
],
|
|
||||||
Node "expenses" [
|
|
||||||
Node "expenses:food" [],
|
|
||||||
Node "expenses:supplies" []
|
|
||||||
],
|
|
||||||
Node "income" [
|
|
||||||
Node "income:gifts" [],
|
|
||||||
Node "income:salary" []
|
|
||||||
],
|
|
||||||
Node "liabilities" [
|
|
||||||
Node "liabilities:debts" []
|
|
||||||
]
|
|
||||||
]
|
|
||||||
)
|
|
||||||
t
|
|
||||||
mapM_
|
|
||||||
(\(e,a) -> assertEqual "" e a)
|
|
||||||
(zip [
|
|
||||||
("assets",Account "assets" [] (Mixed [dollars (-1)]))
|
|
||||||
,("assets:bank",Account "assets:bank" [] (Mixed [dollars 1]))
|
|
||||||
,("assets:bank:checking",Account "assets:bank:checking" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:bank:checking",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
},
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:bank:checking",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
},
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:bank:checking",
|
|
||||||
pamount=(Mixed [dollars (-1)]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
},
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:bank:checking",
|
|
||||||
pamount=(Mixed [dollars (-1)]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [nullamt]))
|
|
||||||
,("assets:bank:saving",Account "assets:bank:saving" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:bank:saving",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars 1]))
|
|
||||||
,("assets:cash",Account "assets:cash" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="assets:cash",
|
|
||||||
pamount=(Mixed [dollars (-2)]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars (-2)]))
|
|
||||||
,("expenses",Account "expenses" [] (Mixed [dollars 2]))
|
|
||||||
,("expenses:food",Account "expenses:food" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="expenses:food",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars 1]))
|
|
||||||
,("expenses:supplies",Account "expenses:supplies" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="expenses:supplies",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars 1]))
|
|
||||||
,("income",Account "income" [] (Mixed [dollars (-2)]))
|
|
||||||
,("income:gifts",Account "income:gifts" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="income:gifts",
|
|
||||||
pamount=(Mixed [dollars (-1)]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars (-1)]))
|
|
||||||
,("income:salary",Account "income:salary" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="income:salary",
|
|
||||||
pamount=(Mixed [dollars (-1)]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars (-1)]))
|
|
||||||
,("liabilities",Account "liabilities" [] (Mixed [dollars 1]))
|
|
||||||
,("liabilities:debts",Account "liabilities:debts" [
|
|
||||||
Posting {
|
|
||||||
pstatus=False,
|
|
||||||
paccount="liabilities:debts",
|
|
||||||
pamount=(Mixed [dollars 1]),
|
|
||||||
pcomment="",
|
|
||||||
ptype=RegularPosting,
|
|
||||||
ptags=[],
|
|
||||||
ptransaction=Nothing
|
|
||||||
}
|
|
||||||
] (Mixed [dollars 1]))
|
|
||||||
,("top",Account "top" [] (Mixed [nullamt]))
|
|
||||||
]
|
|
||||||
(toAscList m)
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Given a list of postings, return an account name tree and three query
|
|
||||||
-- functions that fetch postings, subaccount-excluding-balance and
|
|
||||||
-- subaccount-including-balance by account name.
|
|
||||||
groupPostings :: [Posting] -> (Tree AccountName,
|
|
||||||
(AccountName -> [Posting]),
|
|
||||||
(AccountName -> MixedAmount),
|
|
||||||
(AccountName -> MixedAmount))
|
|
||||||
groupPostings ps = (ant, psof, exclbalof, inclbalof)
|
|
||||||
where
|
|
||||||
anames = sort $ nub $ map paccount ps
|
|
||||||
ant = accountNameTreeFrom $ expandAccountNames anames
|
|
||||||
allanames = flatten ant
|
|
||||||
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
|
|
||||||
psof = (pmap !)
|
|
||||||
balmap = Map.fromList $ flatten $ calculateBalances ant psof
|
|
||||||
exclbalof = fst . (balmap !)
|
|
||||||
inclbalof = snd . (balmap !)
|
|
||||||
|
|
||||||
-- | Add subaccount-excluding and subaccount-including balances to a tree
|
|
||||||
-- of account names somewhat efficiently, given a function that looks up
|
|
||||||
-- transactions by account name.
|
|
||||||
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
|
|
||||||
calculateBalances ant psof = addbalances ant
|
|
||||||
where
|
|
||||||
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
|
|
||||||
where
|
|
||||||
bal = sumPostings $ psof a
|
|
||||||
subsbal = sum $ map (snd . snd . root) subs'
|
|
||||||
subs' = map addbalances subs
|
|
||||||
|
|
||||||
-- | Convert a list of postings to a map from account name to that
|
|
||||||
-- account's postings.
|
|
||||||
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
|
|
||||||
postingsByAccount ps = m'
|
|
||||||
where
|
|
||||||
sortedps = sortBy (comparing paccount) ps
|
|
||||||
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
|
|
||||||
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
|
|
||||||
|
|
||||||
-- debug helpers
|
-- debug helpers
|
||||||
-- traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
|
-- traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
|
||||||
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
|
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
|
||||||
@ -885,11 +679,10 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
|||||||
(TOD 0 0)
|
(TOD 0 0)
|
||||||
|
|
||||||
tests_Hledger_Data_Journal = TestList $
|
tests_Hledger_Data_Journal = TestList $
|
||||||
tests_journalAccountInfo
|
[
|
||||||
-- [
|
|
||||||
-- "query standard account types" ~:
|
-- "query standard account types" ~:
|
||||||
-- do
|
-- do
|
||||||
-- let j = journal1
|
-- let j = journal1
|
||||||
-- journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"]
|
-- journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"]
|
||||||
-- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
|
-- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
|
||||||
-- ]
|
]
|
||||||
|
|||||||
@ -9,90 +9,73 @@ balances, and postings in each account.
|
|||||||
|
|
||||||
module Hledger.Data.Ledger
|
module Hledger.Data.Ledger
|
||||||
where
|
where
|
||||||
import Data.Map (Map, findWithDefault, fromList)
|
import qualified Data.Map as M
|
||||||
import Data.Tree
|
import Safe (headDef)
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
|
||||||
import Hledger.Utils
|
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
import Hledger.Data.Account (nullacct)
|
import Hledger.Data.Account
|
||||||
import Hledger.Data.AccountName
|
|
||||||
import Hledger.Data.Journal
|
import Hledger.Data.Journal
|
||||||
import Hledger.Data.Posting
|
import Hledger.Data.Posting
|
||||||
import Hledger.Query
|
import Hledger.Query
|
||||||
|
|
||||||
|
|
||||||
instance Show Ledger where
|
instance Show Ledger where
|
||||||
show l = printf "Ledger with %d transactions, %d accounts\n%s"
|
show l = printf "Ledger with %d transactions, %d accounts\n" --"%s"
|
||||||
(length (jtxns $ ledgerJournal l) +
|
(length (jtxns $ ljournal l) +
|
||||||
length (jmodifiertxns $ ledgerJournal l) +
|
length (jmodifiertxns $ ljournal l) +
|
||||||
length (jperiodictxns $ ledgerJournal l))
|
length (jperiodictxns $ ljournal l))
|
||||||
(length $ ledgerAccountNames l)
|
(length $ ledgerAccountNames l)
|
||||||
(showtree $ ledgerAccountNameTree l)
|
-- (showtree $ ledgerAccountNameTree l)
|
||||||
|
|
||||||
nullledger :: Ledger
|
nullledger :: Ledger
|
||||||
nullledger = Ledger{
|
nullledger = Ledger {
|
||||||
ledgerJournal = nulljournal,
|
ljournal = nulljournal,
|
||||||
ledgerAccountNameTree = nullaccountnametree,
|
laccounts = []
|
||||||
ledgerAccountMap = fromList []
|
}
|
||||||
}
|
|
||||||
|
|
||||||
-- | Filter a journal's transactions as specified, and then process them
|
-- | Filter a journal's transactions with the given query, then derive a
|
||||||
-- to derive a ledger containing all balances, the chart of accounts,
|
-- ledger containing the chart of accounts and balances. If the query
|
||||||
-- canonicalised commodities etc.
|
-- includes a depth limit, that will affect the ledger's journal but not
|
||||||
journalToLedger :: Query -> Journal -> Ledger
|
-- the account tree.
|
||||||
journalToLedger q j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=amap}
|
ledgerFromJournal :: Query -> Journal -> Ledger
|
||||||
where j' = filterJournalPostings q j
|
ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
|
||||||
(t, amap) = journalAccountInfo j'
|
where
|
||||||
|
(q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
|
||||||
tests_journalToLedger = [
|
j' = filterJournalPostings q' j
|
||||||
"journalToLedger" ~: do
|
as = accountsFromPostings $ journalPostings j'
|
||||||
assertEqual "" (0) (length $ ledgerPostings $ journalToLedger Any nulljournal)
|
j'' = filterJournalPostings depthq j'
|
||||||
assertEqual "" (11) (length $ ledgerPostings $ journalToLedger Any samplejournal)
|
|
||||||
assertEqual "" (6) (length $ ledgerPostings $ journalToLedger (Depth 2) samplejournal)
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | List a ledger's account names.
|
-- | List a ledger's account names.
|
||||||
ledgerAccountNames :: Ledger -> [AccountName]
|
ledgerAccountNames :: Ledger -> [AccountName]
|
||||||
ledgerAccountNames = drop 1 . flatten . ledgerAccountNameTree
|
ledgerAccountNames = drop 1 . map aname . laccounts
|
||||||
|
|
||||||
-- | Get the named account from a ledger.
|
-- | Get the named account from a ledger.
|
||||||
ledgerAccount :: Ledger -> AccountName -> Account
|
ledgerAccount :: Ledger -> AccountName -> Maybe Account
|
||||||
ledgerAccount l a = findWithDefault nullacct a $ ledgerAccountMap l
|
ledgerAccount l a = lookupAccount a $ laccounts l
|
||||||
|
|
||||||
-- | List a ledger's accounts, in tree order
|
-- | Get this ledger's root account, which is a dummy "root" account
|
||||||
ledgerAccounts :: Ledger -> [Account]
|
-- above all others. This should always be first in the account list,
|
||||||
ledgerAccounts = drop 1 . flatten . ledgerAccountTree 9999
|
-- if somehow not this returns a null account.
|
||||||
|
ledgerRootAccount :: Ledger -> Account
|
||||||
|
ledgerRootAccount = headDef nullacct . laccounts
|
||||||
|
|
||||||
-- | List a ledger's top-level accounts, in tree order
|
-- | List a ledger's top-level accounts (the ones below the root), in tree order.
|
||||||
ledgerTopAccounts :: Ledger -> [Account]
|
ledgerTopAccounts :: Ledger -> [Account]
|
||||||
ledgerTopAccounts = map root . branches . ledgerAccountTree 9999
|
ledgerTopAccounts = asubs . head . laccounts
|
||||||
|
|
||||||
-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order
|
-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
|
||||||
ledgerLeafAccounts :: Ledger -> [Account]
|
ledgerLeafAccounts :: Ledger -> [Account]
|
||||||
ledgerLeafAccounts = leaves . ledgerAccountTree 9999
|
ledgerLeafAccounts = filter (null.asubs) . laccounts
|
||||||
|
|
||||||
-- | Accounts in ledger whose name matches the pattern, in tree order.
|
-- | Accounts in ledger whose name matches the pattern, in tree order.
|
||||||
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
|
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
|
||||||
ledgerAccountsMatching pats = filter (matchpats pats . aname) . ledgerAccounts
|
ledgerAccountsMatching pats = filter (matchpats pats . aname) . laccounts
|
||||||
|
|
||||||
-- | List a ledger account's immediate subaccounts
|
|
||||||
ledgerSubAccounts :: Ledger -> Account -> [Account]
|
|
||||||
ledgerSubAccounts l Account{aname=a} =
|
|
||||||
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ ledgerAccountNames l
|
|
||||||
|
|
||||||
-- | List a ledger's postings, in the order parsed.
|
-- | List a ledger's postings, in the order parsed.
|
||||||
ledgerPostings :: Ledger -> [Posting]
|
ledgerPostings :: Ledger -> [Posting]
|
||||||
ledgerPostings = journalPostings . ledgerJournal
|
ledgerPostings = journalPostings . ljournal
|
||||||
|
|
||||||
-- | Get a ledger's tree of accounts to the specified depth.
|
|
||||||
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
|
||||||
ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ ledgerAccountNameTree l
|
|
||||||
|
|
||||||
-- | Get a ledger's tree of accounts rooted at the specified account.
|
|
||||||
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
|
||||||
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
|
||||||
|
|
||||||
-- | The (fully specified) date span containing all the ledger's (filtered) transactions,
|
-- | The (fully specified) date span containing all the ledger's (filtered) transactions,
|
||||||
-- or DateSpan Nothing Nothing if there are none.
|
-- or DateSpan Nothing Nothing if there are none.
|
||||||
@ -100,9 +83,16 @@ ledgerDateSpan :: Ledger -> DateSpan
|
|||||||
ledgerDateSpan = postingsDateSpan . ledgerPostings
|
ledgerDateSpan = postingsDateSpan . ledgerPostings
|
||||||
|
|
||||||
-- | All commodities used in this ledger, as a map keyed by symbol.
|
-- | All commodities used in this ledger, as a map keyed by symbol.
|
||||||
ledgerCommodities :: Ledger -> Map String Commodity
|
ledgerCommodities :: Ledger -> M.Map String Commodity
|
||||||
ledgerCommodities = journalCanonicalCommodities . ledgerJournal
|
ledgerCommodities = journalCanonicalCommodities . 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_Hledger_Data_Ledger = TestList $
|
||||||
tests_journalToLedger
|
tests_ledgerFromJournal
|
||||||
|
|
||||||
|
|||||||
@ -11,23 +11,10 @@ Here is an overview of the hledger data model:
|
|||||||
>
|
>
|
||||||
> Ledger -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains..
|
> Ledger -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains..
|
||||||
> Journal -- a filtered copy of the original journal, containing only the transactions and postings we are interested in
|
> Journal -- a filtered copy of the original journal, containing only the transactions and postings we are interested in
|
||||||
> Tree AccountName -- all accounts named by the journal's transactions, as a hierarchy
|
> [Account] -- all accounts, in tree order beginning with a "root" account", with their balances and sub/parent accounts
|
||||||
> Map AccountName Account -- the postings, and resulting balances, in each account
|
|
||||||
|
|
||||||
For more detailed documentation on each type, see the corresponding modules.
|
For more detailed documentation on each type, see the corresponding modules.
|
||||||
|
|
||||||
Evolution of transaction\/entry\/posting terminology:
|
|
||||||
|
|
||||||
- ledger 2: entries contain transactions
|
|
||||||
|
|
||||||
- hledger 0.4: Entrys contain RawTransactions (which are flattened to Transactions)
|
|
||||||
|
|
||||||
- ledger 3: transactions contain postings
|
|
||||||
|
|
||||||
- hledger 0.5: LedgerTransactions contain Postings (which are flattened to Transactions)
|
|
||||||
|
|
||||||
- hledger 0.8: Transactions contain Postings (referencing Transactions..)
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Data.Types
|
module Hledger.Data.Types
|
||||||
@ -35,9 +22,7 @@ where
|
|||||||
import Control.Monad.Error (ErrorT)
|
import Control.Monad.Error (ErrorT)
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime
|
||||||
import Data.Tree
|
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import qualified Data.Map as Map
|
|
||||||
import System.Time (ClockTime)
|
import System.Time (ClockTime)
|
||||||
|
|
||||||
|
|
||||||
@ -99,7 +84,7 @@ data Posting = Posting {
|
|||||||
ptype :: PostingType,
|
ptype :: PostingType,
|
||||||
ptags :: [Tag],
|
ptags :: [Tag],
|
||||||
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
|
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
|
||||||
-- Tying this knot gets tedious, Maybe makes it easier/optional.
|
-- Tying this knot gets tedious, Maybe makes it easier/optional.
|
||||||
}
|
}
|
||||||
|
|
||||||
-- The equality test for postings ignores the parent transaction's
|
-- The equality test for postings ignores the parent transaction's
|
||||||
@ -115,7 +100,7 @@ data Transaction = Transaction {
|
|||||||
tdescription :: String,
|
tdescription :: String,
|
||||||
tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string
|
tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string
|
||||||
ttags :: [Tag],
|
ttags :: [Tag],
|
||||||
tpostings :: [Posting], -- ^ this transaction's postings (co-recursive types).
|
tpostings :: [Posting], -- ^ this transaction's postings
|
||||||
tpreceding_comment_lines :: String
|
tpreceding_comment_lines :: String
|
||||||
} deriving (Eq)
|
} deriving (Eq)
|
||||||
|
|
||||||
@ -248,15 +233,23 @@ data FormatString =
|
|||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
data Ledger = Ledger {
|
-- | An account, with name, balances and links to parent/subaccounts
|
||||||
ledgerJournal :: Journal,
|
-- which let you walk up or down the account tree.
|
||||||
ledgerAccountNameTree :: Tree AccountName,
|
|
||||||
ledgerAccountMap :: Map.Map AccountName Account
|
|
||||||
}
|
|
||||||
|
|
||||||
data Account = Account {
|
data Account = Account {
|
||||||
aname :: AccountName,
|
aname :: AccountName, -- ^ this account's full name
|
||||||
apostings :: [Posting], -- ^ postings in this account
|
aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts
|
||||||
abalance :: MixedAmount -- ^ sum of postings in this account and subaccounts
|
asubs :: [Account], -- ^ sub-accounts
|
||||||
} -- deriving (Eq) XXX
|
-- derived from the above:
|
||||||
|
aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts
|
||||||
|
aparent :: Maybe Account, -- ^ parent account
|
||||||
|
aboring :: Bool -- ^ used in the accounts report to label elidable parents
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | A Ledger has the journal it derives from, and the accounts
|
||||||
|
-- derived from that. Accounts are accessible both list-wise and
|
||||||
|
-- tree-wise, since each one knows its parent and subs; the first
|
||||||
|
-- account is the root of the tree and always exists.
|
||||||
|
data Ledger = Ledger {
|
||||||
|
ljournal :: Journal,
|
||||||
|
laccounts :: [Account]
|
||||||
|
}
|
||||||
|
|||||||
@ -42,7 +42,6 @@ module Hledger.Reports (
|
|||||||
AccountsReport,
|
AccountsReport,
|
||||||
AccountsReportItem,
|
AccountsReportItem,
|
||||||
accountsReport,
|
accountsReport,
|
||||||
isInteresting,
|
|
||||||
-- * Tests
|
-- * Tests
|
||||||
tests_Hledger_Reports
|
tests_Hledger_Reports
|
||||||
)
|
)
|
||||||
@ -51,6 +50,7 @@ where
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
-- import qualified Data.Map as M
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
-- import Data.Tree
|
-- import Data.Tree
|
||||||
@ -151,6 +151,9 @@ clearedValueFromOpts ReportOpts{..} | cleared_ = Just True
|
|||||||
| uncleared_ = Just False
|
| uncleared_ = Just False
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
-- depthFromOpts :: ReportOpts -> Int
|
||||||
|
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
|
||||||
|
|
||||||
-- | Report which date we will report on based on --effective.
|
-- | Report which date we will report on based on --effective.
|
||||||
whichDateFromOpts :: ReportOpts -> WhichDate
|
whichDateFromOpts :: ReportOpts -> WhichDate
|
||||||
whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
|
whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
|
||||||
@ -284,6 +287,297 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
|
|||||||
| otherwise = requestedspan `spanIntersect` matchedspan
|
| otherwise = requestedspan `spanIntersect` matchedspan
|
||||||
startbal = sumPostings precedingps
|
startbal = sumPostings precedingps
|
||||||
|
|
||||||
|
totallabel = "Total"
|
||||||
|
balancelabel = "Balance"
|
||||||
|
|
||||||
|
-- | Generate postings report line items.
|
||||||
|
postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
|
||||||
|
postingsReportItems [] _ _ _ _ = []
|
||||||
|
postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn)
|
||||||
|
where
|
||||||
|
i = mkpostingsReportItem isfirst p' b'
|
||||||
|
p' = p{paccount=clipAccountName d $ paccount p}
|
||||||
|
isfirst = ptransaction p /= ptransaction pprev
|
||||||
|
b' = b `sumfn` pamount p
|
||||||
|
|
||||||
|
-- | Generate one postings report line item, given a flag indicating
|
||||||
|
-- whether to include transaction info, the posting, and the current
|
||||||
|
-- running balance.
|
||||||
|
mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem
|
||||||
|
mkpostingsReportItem False p b = (Nothing, p, b)
|
||||||
|
mkpostingsReportItem True p b = (ds, p, b)
|
||||||
|
where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
|
||||||
|
Nothing -> Just (nulldate,"")
|
||||||
|
|
||||||
|
-- | Date-sort and split a list of postings into three spans - postings matched
|
||||||
|
-- by the given display expression, and the preceding and following postings.
|
||||||
|
postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
|
||||||
|
postingsMatchingDisplayExpr d ps = (before, matched, after)
|
||||||
|
where
|
||||||
|
sorted = sortBy (comparing postingDate) ps
|
||||||
|
(before, rest) = break (displayExprMatches d) sorted
|
||||||
|
(matched, after) = span (displayExprMatches d) rest
|
||||||
|
|
||||||
|
-- | Does this display expression allow this posting to be displayed ?
|
||||||
|
-- Raises an error if the display expression can't be parsed.
|
||||||
|
displayExprMatches :: Maybe String -> Posting -> Bool
|
||||||
|
displayExprMatches Nothing _ = True
|
||||||
|
displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
|
||||||
|
|
||||||
|
-- | Parse a hledger display expression, which is a simple date test like
|
||||||
|
-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
|
||||||
|
datedisplayexpr :: GenParser Char st (Posting -> Bool)
|
||||||
|
datedisplayexpr = do
|
||||||
|
char 'd'
|
||||||
|
op <- compareop
|
||||||
|
char '['
|
||||||
|
(y,m,d) <- smartdate
|
||||||
|
char ']'
|
||||||
|
let date = parsedate $ printf "%04s/%02s/%02s" y m d
|
||||||
|
test op = return $ (`op` date) . postingDate
|
||||||
|
case op of
|
||||||
|
"<" -> test (<)
|
||||||
|
"<=" -> test (<=)
|
||||||
|
"=" -> test (==)
|
||||||
|
"==" -> test (==)
|
||||||
|
">=" -> test (>=)
|
||||||
|
">" -> test (>)
|
||||||
|
_ -> mzero
|
||||||
|
where
|
||||||
|
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
|
||||||
|
|
||||||
|
-- -- | Clip the account names to the specified depth in a list of postings.
|
||||||
|
-- depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
|
||||||
|
-- depthClipPostings depth = map (depthClipPosting depth)
|
||||||
|
|
||||||
|
-- -- | Clip a posting's account name to the specified depth.
|
||||||
|
-- depthClipPosting :: Maybe Int -> Posting -> Posting
|
||||||
|
-- depthClipPosting Nothing p = p
|
||||||
|
-- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
|
||||||
|
|
||||||
|
-- XXX confusing, refactor
|
||||||
|
|
||||||
|
-- | Convert a list of postings into summary postings. Summary postings
|
||||||
|
-- are one per account per interval and aggregated to the specified depth
|
||||||
|
-- if any.
|
||||||
|
summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
|
||||||
|
summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
|
||||||
|
where
|
||||||
|
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
|
||||||
|
postingsinspan s = filter (isPostingInDateSpan s) ps
|
||||||
|
|
||||||
|
tests_summarisePostingsByInterval = [
|
||||||
|
"summarisePostingsByInterval" ~: do
|
||||||
|
summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | Given a date span (representing a reporting interval) and a list of
|
||||||
|
-- postings within it: aggregate the postings so there is only one per
|
||||||
|
-- account, and adjust their date/description so that they will render
|
||||||
|
-- as a summary for this interval.
|
||||||
|
--
|
||||||
|
-- As usual with date spans the end date is exclusive, but for display
|
||||||
|
-- purposes we show the previous day as end date, like ledger.
|
||||||
|
--
|
||||||
|
-- When a depth argument is present, postings to accounts of greater
|
||||||
|
-- depth are aggregated where possible.
|
||||||
|
--
|
||||||
|
-- The showempty flag includes spans with no postings and also postings
|
||||||
|
-- with 0 amount.
|
||||||
|
summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
|
||||||
|
summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
|
||||||
|
| null ps && (isNothing b || isNothing e) = []
|
||||||
|
| null ps && showempty = [summaryp]
|
||||||
|
| otherwise = summaryps'
|
||||||
|
where
|
||||||
|
summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
|
||||||
|
b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
|
||||||
|
e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
|
||||||
|
summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
|
||||||
|
summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
|
||||||
|
summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
|
||||||
|
clippedanames = nub $ map (clipAccountName depth) anames
|
||||||
|
anames = sort $ nub $ map paccount ps
|
||||||
|
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
|
||||||
|
accts = accountsFromPostings ps
|
||||||
|
balance a = maybe nullmixedamt bal $ lookupAccount a accts
|
||||||
|
where
|
||||||
|
bal = if isclipped a then aibalance else aebalance
|
||||||
|
isclipped a = accountNameLevel a >= depth
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | A transactions report includes a list of transactions
|
||||||
|
-- (posting-filtered and unfiltered variants), a running balance, and some
|
||||||
|
-- other information helpful for rendering a register view (a flag
|
||||||
|
-- indicating multiple other accounts and a display string describing
|
||||||
|
-- them) with or without a notion of current account(s).
|
||||||
|
type TransactionsReport = (String -- label for the balance column, eg "balance" or "total"
|
||||||
|
,[TransactionsReportItem] -- line items, one per transaction
|
||||||
|
)
|
||||||
|
type TransactionsReportItem = (Transaction -- the corresponding transaction
|
||||||
|
,Transaction -- the transaction with postings to the current account(s) removed
|
||||||
|
,Bool -- is this a split, ie more than one other account posting
|
||||||
|
,String -- a display string describing the other account(s), if any
|
||||||
|
,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
|
||||||
|
,MixedAmount -- the running balance for the current account(s) after this transaction
|
||||||
|
)
|
||||||
|
|
||||||
|
triDate (t,_,_,_,_,_) = tdate t
|
||||||
|
triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
|
||||||
|
(Amount{quantity=q}):_ -> show q
|
||||||
|
|
||||||
|
-- | Select transactions from the whole journal for a transactions report,
|
||||||
|
-- with no \"current\" account. The end result is similar to
|
||||||
|
-- "postingsReport" except it uses queries and transaction-based report
|
||||||
|
-- items and the items are most recent first. Used by eg hledger-web's
|
||||||
|
-- journal view.
|
||||||
|
journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
|
||||||
|
journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
|
||||||
|
where
|
||||||
|
ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
|
||||||
|
items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'
|
||||||
|
-- XXX items' first element should be the full transaction with all postings
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Select transactions within one or more \"current\" accounts, and make a
|
||||||
|
-- transactions report relative to those account(s). This means:
|
||||||
|
--
|
||||||
|
-- 1. it shows transactions from the point of view of the current account(s).
|
||||||
|
-- The transaction amount is the amount posted to the current account(s).
|
||||||
|
-- The other accounts' names are provided.
|
||||||
|
--
|
||||||
|
-- 2. With no transaction filtering in effect other than a start date, it
|
||||||
|
-- shows the accurate historical running balance for the current account(s).
|
||||||
|
-- Otherwise it shows a running total starting at 0.
|
||||||
|
--
|
||||||
|
-- Currently, reporting intervals are not supported, and report items are
|
||||||
|
-- most recent first. Used by eg hledger-web's account register view.
|
||||||
|
--
|
||||||
|
accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
|
||||||
|
accountTransactionsReport opts j m thisacctquery = (label, items)
|
||||||
|
where
|
||||||
|
-- transactions affecting this account, in date order
|
||||||
|
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
|
||||||
|
journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
||||||
|
-- starting balance: if we are filtering by a start date and nothing else,
|
||||||
|
-- the sum of postings to this account before that date; otherwise zero.
|
||||||
|
(startbal,label) | queryIsNull m = (nullmixedamt, balancelabel)
|
||||||
|
| queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
|
||||||
|
| otherwise = (nullmixedamt, totallabel)
|
||||||
|
where
|
||||||
|
priorps = -- ltrace "priorps" $
|
||||||
|
filter (matchesPosting
|
||||||
|
(-- ltrace "priormatcher" $
|
||||||
|
And [thisacctquery, tostartdatequery]))
|
||||||
|
$ transactionsPostings ts
|
||||||
|
tostartdatequery = Date (DateSpan Nothing startdate)
|
||||||
|
startdate = queryStartDate (effective_ opts) m
|
||||||
|
items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
|
||||||
|
|
||||||
|
-- | Generate transactions report items from a list of transactions,
|
||||||
|
-- using the provided query and current account queries, starting balance,
|
||||||
|
-- sign-setting function and balance-summing function.
|
||||||
|
accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
|
||||||
|
accountTransactionsReportItems _ _ _ _ [] = []
|
||||||
|
accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
|
||||||
|
-- This is used for both accountTransactionsReport and journalTransactionsReport,
|
||||||
|
-- which makes it a bit overcomplicated
|
||||||
|
case i of Just i' -> i':is
|
||||||
|
Nothing -> is
|
||||||
|
where
|
||||||
|
tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t
|
||||||
|
(psthisacct,psotheracct) = case thisacctquery of Just m -> partition (matchesPosting m) psmatched
|
||||||
|
Nothing -> ([],psmatched)
|
||||||
|
numotheraccts = length $ nub $ map paccount psotheracct
|
||||||
|
amt = negate $ sum $ map pamount psthisacct
|
||||||
|
acct | isNothing thisacctquery = summarisePostings psmatched -- journal register
|
||||||
|
| numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
|
||||||
|
| otherwise = prefix ++ summarisePostingAccounts psotheracct
|
||||||
|
where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
|
||||||
|
(i,bal') = case psmatched of
|
||||||
|
[] -> (Nothing,bal)
|
||||||
|
_ -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
|
||||||
|
where
|
||||||
|
a = signfn amt
|
||||||
|
b = bal + a
|
||||||
|
is = accountTransactionsReportItems query thisacctquery bal' signfn ts
|
||||||
|
|
||||||
|
-- | Generate a short readable summary of some postings, like
|
||||||
|
-- "from (negatives) to (positives)".
|
||||||
|
summarisePostings :: [Posting] -> String
|
||||||
|
summarisePostings ps =
|
||||||
|
case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
|
||||||
|
("",t) -> "to "++t
|
||||||
|
(f,"") -> "from "++f
|
||||||
|
(f,t) -> "from "++f++" to "++t
|
||||||
|
where
|
||||||
|
(froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
|
||||||
|
|
||||||
|
-- | Generate a simplified summary of some postings' accounts.
|
||||||
|
summarisePostingAccounts :: [Posting] -> String
|
||||||
|
summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
|
||||||
|
|
||||||
|
filterTransactionPostings :: Query -> Transaction -> Transaction
|
||||||
|
filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | An accounts report is a list of account names (full and short
|
||||||
|
-- variants) with their balances, appropriate indentation for rendering as
|
||||||
|
-- a hierarchy, and grand total.
|
||||||
|
type AccountsReport = ([AccountsReportItem] -- line items, one per account
|
||||||
|
,MixedAmount -- total balance of all accounts
|
||||||
|
)
|
||||||
|
type AccountsReportItem = (AccountName -- full account name
|
||||||
|
,AccountName -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
|
||||||
|
,Int -- how many steps to indent this account (0-based account depth excluding boring parents)
|
||||||
|
,MixedAmount) -- account balance, includes subs unless --flat is present
|
||||||
|
|
||||||
|
-- | Select accounts, and get their balances at the end of the selected
|
||||||
|
-- period, and misc. display information, for an accounts report.
|
||||||
|
accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
|
||||||
|
accountsReport opts q j = (items, total)
|
||||||
|
where
|
||||||
|
l = ledgerFromJournal q $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
||||||
|
accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
|
||||||
|
accts'
|
||||||
|
| flat_ opts = filterzeros $ tail $ flattenAccounts accts
|
||||||
|
| otherwise = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts
|
||||||
|
where
|
||||||
|
filterzeros | empty_ opts = id
|
||||||
|
| otherwise = filter (not . isZeroMixedAmount . aebalance)
|
||||||
|
prunezeros | empty_ opts = id
|
||||||
|
| otherwise = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)
|
||||||
|
markboring | no_elide_ opts = id
|
||||||
|
| otherwise = markBoringParentAccounts
|
||||||
|
items = map (accountsReportItem opts) accts'
|
||||||
|
total = sum [amt | (_,_,depth,amt) <- items, depth==0]
|
||||||
|
|
||||||
|
-- | In an account tree with zero-balance leaves removed, mark the
|
||||||
|
-- elidable parent accounts (those with one subaccount and no balance
|
||||||
|
-- of their own).
|
||||||
|
markBoringParentAccounts :: Account -> Account
|
||||||
|
markBoringParentAccounts = tieAccountParents . mapAccounts mark
|
||||||
|
where
|
||||||
|
mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}
|
||||||
|
| otherwise = a
|
||||||
|
|
||||||
|
accountsReportItem :: ReportOpts -> Account -> AccountsReportItem
|
||||||
|
accountsReportItem opts a@Account{aname=name, aibalance=ibal}
|
||||||
|
| flat_ opts = (name, name, 0, ibal)
|
||||||
|
| otherwise = (name, elidedname, depth, ibal)
|
||||||
|
where
|
||||||
|
elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
|
||||||
|
adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents
|
||||||
|
depth = length $ filter (not.aboring) parents
|
||||||
|
parents = init $ parentAccounts a
|
||||||
|
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- TESTS
|
||||||
|
|
||||||
tests_postingsReport = [
|
tests_postingsReport = [
|
||||||
"postingsReport" ~: do
|
"postingsReport" ~: do
|
||||||
|
|
||||||
@ -450,284 +744,6 @@ tests_postingsReport = [
|
|||||||
-}
|
-}
|
||||||
]
|
]
|
||||||
|
|
||||||
totallabel = "Total"
|
|
||||||
balancelabel = "Balance"
|
|
||||||
|
|
||||||
-- | Generate postings report line items.
|
|
||||||
postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
|
|
||||||
postingsReportItems [] _ _ _ _ = []
|
|
||||||
postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn)
|
|
||||||
where
|
|
||||||
i = mkpostingsReportItem isfirst p' b'
|
|
||||||
p' = p{paccount=clipAccountName d $ paccount p}
|
|
||||||
isfirst = ptransaction p /= ptransaction pprev
|
|
||||||
b' = b `sumfn` pamount p
|
|
||||||
|
|
||||||
-- | Generate one postings report line item, given a flag indicating
|
|
||||||
-- whether to include transaction info, the posting, and the current
|
|
||||||
-- running balance.
|
|
||||||
mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem
|
|
||||||
mkpostingsReportItem False p b = (Nothing, p, b)
|
|
||||||
mkpostingsReportItem True p b = (ds, p, b)
|
|
||||||
where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
|
|
||||||
Nothing -> Just (nulldate,"")
|
|
||||||
|
|
||||||
-- | Date-sort and split a list of postings into three spans - postings matched
|
|
||||||
-- by the given display expression, and the preceding and following postings.
|
|
||||||
postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
|
|
||||||
postingsMatchingDisplayExpr d ps = (before, matched, after)
|
|
||||||
where
|
|
||||||
sorted = sortBy (comparing postingDate) ps
|
|
||||||
(before, rest) = break (displayExprMatches d) sorted
|
|
||||||
(matched, after) = span (displayExprMatches d) rest
|
|
||||||
|
|
||||||
-- | Does this display expression allow this posting to be displayed ?
|
|
||||||
-- Raises an error if the display expression can't be parsed.
|
|
||||||
displayExprMatches :: Maybe String -> Posting -> Bool
|
|
||||||
displayExprMatches Nothing _ = True
|
|
||||||
displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
|
|
||||||
|
|
||||||
-- | Parse a hledger display expression, which is a simple date test like
|
|
||||||
-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
|
|
||||||
datedisplayexpr :: GenParser Char st (Posting -> Bool)
|
|
||||||
datedisplayexpr = do
|
|
||||||
char 'd'
|
|
||||||
op <- compareop
|
|
||||||
char '['
|
|
||||||
(y,m,d) <- smartdate
|
|
||||||
char ']'
|
|
||||||
let date = parsedate $ printf "%04s/%02s/%02s" y m d
|
|
||||||
test op = return $ (`op` date) . postingDate
|
|
||||||
case op of
|
|
||||||
"<" -> test (<)
|
|
||||||
"<=" -> test (<=)
|
|
||||||
"=" -> test (==)
|
|
||||||
"==" -> test (==)
|
|
||||||
">=" -> test (>=)
|
|
||||||
">" -> test (>)
|
|
||||||
_ -> mzero
|
|
||||||
where
|
|
||||||
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
|
|
||||||
|
|
||||||
-- -- | Clip the account names to the specified depth in a list of postings.
|
|
||||||
-- depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
|
|
||||||
-- depthClipPostings depth = map (depthClipPosting depth)
|
|
||||||
|
|
||||||
-- -- | Clip a posting's account name to the specified depth.
|
|
||||||
-- depthClipPosting :: Maybe Int -> Posting -> Posting
|
|
||||||
-- depthClipPosting Nothing p = p
|
|
||||||
-- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
|
|
||||||
|
|
||||||
-- XXX confusing, refactor
|
|
||||||
|
|
||||||
-- | Convert a list of postings into summary postings. Summary postings
|
|
||||||
-- are one per account per interval and aggregated to the specified depth
|
|
||||||
-- if any.
|
|
||||||
summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
|
|
||||||
summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
|
|
||||||
where
|
|
||||||
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
|
|
||||||
postingsinspan s = filter (isPostingInDateSpan s) ps
|
|
||||||
|
|
||||||
tests_summarisePostingsByInterval = [
|
|
||||||
"summarisePostingsByInterval" ~: do
|
|
||||||
summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Given a date span (representing a reporting interval) and a list of
|
|
||||||
-- postings within it: aggregate the postings so there is only one per
|
|
||||||
-- account, and adjust their date/description so that they will render
|
|
||||||
-- as a summary for this interval.
|
|
||||||
--
|
|
||||||
-- As usual with date spans the end date is exclusive, but for display
|
|
||||||
-- purposes we show the previous day as end date, like ledger.
|
|
||||||
--
|
|
||||||
-- When a depth argument is present, postings to accounts of greater
|
|
||||||
-- depth are aggregated where possible.
|
|
||||||
--
|
|
||||||
-- The showempty flag includes spans with no postings and also postings
|
|
||||||
-- with 0 amount.
|
|
||||||
summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
|
|
||||||
summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
|
|
||||||
| null ps && (isNothing b || isNothing e) = []
|
|
||||||
| null ps && showempty = [summaryp]
|
|
||||||
| otherwise = summaryps'
|
|
||||||
where
|
|
||||||
summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
|
|
||||||
b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
|
|
||||||
e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
|
|
||||||
summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
|
|
||||||
|
|
||||||
summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
|
|
||||||
summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
|
|
||||||
anames = sort $ nub $ map paccount ps
|
|
||||||
-- aggregate balances by account, like journalToLedger, then do depth-clipping
|
|
||||||
(_,_,exclbalof,inclbalof) = groupPostings ps
|
|
||||||
clippedanames = nub $ map (clipAccountName depth) anames
|
|
||||||
isclipped a = accountNameLevel a >= depth
|
|
||||||
balancetoshowfor a =
|
|
||||||
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- | A transactions report includes a list of transactions
|
|
||||||
-- (posting-filtered and unfiltered variants), a running balance, and some
|
|
||||||
-- other information helpful for rendering a register view (a flag
|
|
||||||
-- indicating multiple other accounts and a display string describing
|
|
||||||
-- them) with or without a notion of current account(s).
|
|
||||||
type TransactionsReport = (String -- label for the balance column, eg "balance" or "total"
|
|
||||||
,[TransactionsReportItem] -- line items, one per transaction
|
|
||||||
)
|
|
||||||
type TransactionsReportItem = (Transaction -- the corresponding transaction
|
|
||||||
,Transaction -- the transaction with postings to the current account(s) removed
|
|
||||||
,Bool -- is this a split, ie more than one other account posting
|
|
||||||
,String -- a display string describing the other account(s), if any
|
|
||||||
,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
|
|
||||||
,MixedAmount -- the running balance for the current account(s) after this transaction
|
|
||||||
)
|
|
||||||
|
|
||||||
triDate (t,_,_,_,_,_) = tdate t
|
|
||||||
triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
|
|
||||||
(Amount{quantity=q}):_ -> show q
|
|
||||||
|
|
||||||
-- | Select transactions from the whole journal for a transactions report,
|
|
||||||
-- with no \"current\" account. The end result is similar to
|
|
||||||
-- "postingsReport" except it uses queries and transaction-based report
|
|
||||||
-- items and the items are most recent first. Used by eg hledger-web's
|
|
||||||
-- journal view.
|
|
||||||
journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
|
|
||||||
journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
|
|
||||||
where
|
|
||||||
ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
|
|
||||||
items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'
|
|
||||||
-- XXX items' first element should be the full transaction with all postings
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- | Select transactions within one or more \"current\" accounts, and make a
|
|
||||||
-- transactions report relative to those account(s). This means:
|
|
||||||
--
|
|
||||||
-- 1. it shows transactions from the point of view of the current account(s).
|
|
||||||
-- The transaction amount is the amount posted to the current account(s).
|
|
||||||
-- The other accounts' names are provided.
|
|
||||||
--
|
|
||||||
-- 2. With no transaction filtering in effect other than a start date, it
|
|
||||||
-- shows the accurate historical running balance for the current account(s).
|
|
||||||
-- Otherwise it shows a running total starting at 0.
|
|
||||||
--
|
|
||||||
-- Currently, reporting intervals are not supported, and report items are
|
|
||||||
-- most recent first. Used by eg hledger-web's account register view.
|
|
||||||
--
|
|
||||||
accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
|
|
||||||
accountTransactionsReport opts j m thisacctquery = (label, items)
|
|
||||||
where
|
|
||||||
-- transactions affecting this account, in date order
|
|
||||||
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
|
|
||||||
journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
|
||||||
-- starting balance: if we are filtering by a start date and nothing else,
|
|
||||||
-- the sum of postings to this account before that date; otherwise zero.
|
|
||||||
(startbal,label) | queryIsNull m = (nullmixedamt, balancelabel)
|
|
||||||
| queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
|
|
||||||
| otherwise = (nullmixedamt, totallabel)
|
|
||||||
where
|
|
||||||
priorps = -- ltrace "priorps" $
|
|
||||||
filter (matchesPosting
|
|
||||||
(-- ltrace "priormatcher" $
|
|
||||||
And [thisacctquery, tostartdatequery]))
|
|
||||||
$ transactionsPostings ts
|
|
||||||
tostartdatequery = Date (DateSpan Nothing startdate)
|
|
||||||
startdate = queryStartDate (effective_ opts) m
|
|
||||||
items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
|
|
||||||
|
|
||||||
-- | Generate transactions report items from a list of transactions,
|
|
||||||
-- using the provided query and current account queries, starting balance,
|
|
||||||
-- sign-setting function and balance-summing function.
|
|
||||||
accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
|
|
||||||
accountTransactionsReportItems _ _ _ _ [] = []
|
|
||||||
accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
|
|
||||||
-- This is used for both accountTransactionsReport and journalTransactionsReport,
|
|
||||||
-- which makes it a bit overcomplicated
|
|
||||||
case i of Just i' -> i':is
|
|
||||||
Nothing -> is
|
|
||||||
where
|
|
||||||
tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t
|
|
||||||
(psthisacct,psotheracct) = case thisacctquery of Just m -> partition (matchesPosting m) psmatched
|
|
||||||
Nothing -> ([],psmatched)
|
|
||||||
numotheraccts = length $ nub $ map paccount psotheracct
|
|
||||||
amt = negate $ sum $ map pamount psthisacct
|
|
||||||
acct | isNothing thisacctquery = summarisePostings psmatched -- journal register
|
|
||||||
| numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
|
|
||||||
| otherwise = prefix ++ summarisePostingAccounts psotheracct
|
|
||||||
where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
|
|
||||||
(i,bal') = case psmatched of
|
|
||||||
[] -> (Nothing,bal)
|
|
||||||
_ -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
|
|
||||||
where
|
|
||||||
a = signfn amt
|
|
||||||
b = bal + a
|
|
||||||
is = accountTransactionsReportItems query thisacctquery bal' signfn ts
|
|
||||||
|
|
||||||
-- | Generate a short readable summary of some postings, like
|
|
||||||
-- "from (negatives) to (positives)".
|
|
||||||
summarisePostings :: [Posting] -> String
|
|
||||||
summarisePostings ps =
|
|
||||||
case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
|
|
||||||
("",t) -> "to "++t
|
|
||||||
(f,"") -> "from "++f
|
|
||||||
(f,t) -> "from "++f++" to "++t
|
|
||||||
where
|
|
||||||
(froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
|
|
||||||
|
|
||||||
-- | Generate a simplified summary of some postings' accounts.
|
|
||||||
summarisePostingAccounts :: [Posting] -> String
|
|
||||||
summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
|
|
||||||
|
|
||||||
filterTransactionPostings :: Query -> Transaction -> Transaction
|
|
||||||
filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- | An accounts report is a list of account names (full and short
|
|
||||||
-- variants) with their balances, appropriate indentation for rendering as
|
|
||||||
-- a hierarchy, and grand total.
|
|
||||||
type AccountsReport = ([AccountsReportItem] -- line items, one per account
|
|
||||||
,MixedAmount -- total balance of all accounts
|
|
||||||
)
|
|
||||||
type AccountsReportItem = (AccountName -- full account name
|
|
||||||
,AccountName -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
|
|
||||||
,Int -- how many steps to indent this account (0-based account depth excluding boring parents)
|
|
||||||
,MixedAmount) -- account balance, includes subs unless --flat is present
|
|
||||||
|
|
||||||
-- | Select accounts, and get their balances at the end of the selected
|
|
||||||
-- period, and misc. display information, for an accounts report.
|
|
||||||
accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
|
|
||||||
accountsReport opts q j = (items, total)
|
|
||||||
where
|
|
||||||
-- don't do depth filtering until the end
|
|
||||||
q1 = filterQuery (not . queryIsDepth) q
|
|
||||||
q2 = filterQuery queryIsDepth q
|
|
||||||
l = journalToLedger q1 $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
|
||||||
acctnames = filter (q2 `matchesAccount`) $ ledgerAccountNames l
|
|
||||||
interestingaccts | no_elide_ opts = acctnames
|
|
||||||
| otherwise = filter (isInteresting opts l) acctnames
|
|
||||||
items = map mkitem interestingaccts
|
|
||||||
total = sum $ map abalance $ ledgerTopAccounts l
|
|
||||||
|
|
||||||
-- | Get data for one balance report line item.
|
|
||||||
mkitem :: AccountName -> AccountsReportItem
|
|
||||||
mkitem a = (a, adisplay, indent, abal)
|
|
||||||
where
|
|
||||||
adisplay | flat_ opts = a
|
|
||||||
| otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
|
|
||||||
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
|
|
||||||
indent | flat_ opts = 0
|
|
||||||
| otherwise = length interestingparents
|
|
||||||
interestingparents = filter (`elem` interestingaccts) parents
|
|
||||||
parents = parentAccountNames a
|
|
||||||
abal | flat_ opts = exclusiveBalance acct
|
|
||||||
| otherwise = abalance acct
|
|
||||||
where acct = ledgerAccount l a
|
|
||||||
|
|
||||||
tests_accountsReport =
|
tests_accountsReport =
|
||||||
let (opts,journal) `gives` r = do
|
let (opts,journal) `gives` r = do
|
||||||
let (eitems, etotal) = r
|
let (eitems, etotal) = r
|
||||||
@ -971,53 +987,13 @@ Right samplejournal2 = journalBalanceTransactions $ Journal
|
|||||||
[]
|
[]
|
||||||
(TOD 0 0)
|
(TOD 0 0)
|
||||||
|
|
||||||
exclusiveBalance :: Account -> MixedAmount
|
-- tests_isInterestingIndented = [
|
||||||
exclusiveBalance = sumPostings . apostings
|
-- "isInterestingIndented" ~: do
|
||||||
|
-- let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
|
||||||
|
-- where l = ledgerFromJournal (queryFromOpts nulldate opts) journal
|
||||||
|
|
||||||
-- | Is the named account considered interesting for this ledger's accounts report,
|
-- (defreportopts, samplejournal, "expenses") `gives` True
|
||||||
-- following the eliding style of ledger's balance command ?
|
-- ]
|
||||||
isInteresting :: ReportOpts -> Ledger -> AccountName -> Bool
|
|
||||||
isInteresting opts l a | flat_ opts = isInterestingFlat opts l a
|
|
||||||
| otherwise = isInterestingIndented opts l a
|
|
||||||
|
|
||||||
-- | Determine whether an account should get its own line in the --flat balance report.
|
|
||||||
isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool
|
|
||||||
isInterestingFlat opts l a = notempty || emptyflag
|
|
||||||
where
|
|
||||||
acct = ledgerAccount l a
|
|
||||||
notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
|
|
||||||
emptyflag = empty_ opts
|
|
||||||
|
|
||||||
-- | Determine whether an account should get its own line in the indented
|
|
||||||
-- balance report. Cf Balance module doc.
|
|
||||||
isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool
|
|
||||||
isInterestingIndented opts l a
|
|
||||||
| numinterestingsubs == 1 && samebalanceassub && not atmaxdepth = False
|
|
||||||
| numinterestingsubs < 2 && zerobalance && not emptyflag = False
|
|
||||||
| otherwise = True
|
|
||||||
where
|
|
||||||
atmaxdepth = accountNameLevel a == depthFromOpts opts
|
|
||||||
emptyflag = empty_ opts
|
|
||||||
acct = ledgerAccount l a
|
|
||||||
zerobalance = isZeroMixedAmount inclbalance where inclbalance = abalance acct
|
|
||||||
samebalanceassub = isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
|
|
||||||
numinterestingsubs = length $ filter isInterestingTree subtrees
|
|
||||||
where
|
|
||||||
isInterestingTree = treeany (isInteresting opts l . aname)
|
|
||||||
subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
|
|
||||||
|
|
||||||
tests_isInterestingIndented = [
|
|
||||||
"isInterestingIndented" ~: do
|
|
||||||
let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
|
|
||||||
where l = journalToLedger (queryFromOpts nulldate opts) journal
|
|
||||||
|
|
||||||
(defreportopts, samplejournal, "expenses") `gives` True
|
|
||||||
]
|
|
||||||
|
|
||||||
depthFromOpts :: ReportOpts -> Int
|
|
||||||
depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
tests_Hledger_Reports :: Test
|
tests_Hledger_Reports :: Test
|
||||||
tests_Hledger_Reports = TestList $
|
tests_Hledger_Reports = TestList $
|
||||||
@ -1026,7 +1002,7 @@ tests_Hledger_Reports = TestList $
|
|||||||
++ tests_entriesReport
|
++ tests_entriesReport
|
||||||
++ tests_summarisePostingsByInterval
|
++ tests_summarisePostingsByInterval
|
||||||
++ tests_postingsReport
|
++ tests_postingsReport
|
||||||
++ tests_isInterestingIndented
|
-- ++ tests_isInterestingIndented
|
||||||
++ tests_accountsReport
|
++ tests_accountsReport
|
||||||
++ [
|
++ [
|
||||||
-- ,"summarisePostingsInDateSpan" ~: do
|
-- ,"summarisePostingsInDateSpan" ~: do
|
||||||
|
|||||||
@ -31,6 +31,7 @@ import Control.Monad.Error (MonadIO)
|
|||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime
|
||||||
@ -237,6 +238,8 @@ splitAtElement e l =
|
|||||||
|
|
||||||
-- trees
|
-- trees
|
||||||
|
|
||||||
|
-- standard tree helpers
|
||||||
|
|
||||||
root = rootLabel
|
root = rootLabel
|
||||||
subs = subForest
|
subs = subForest
|
||||||
branches = subForest
|
branches = subForest
|
||||||
@ -291,6 +294,25 @@ showtree = unlines . filter (regexMatches "[^ \\|]") . lines . drawTree . treema
|
|||||||
showforest :: Show a => Forest a -> String
|
showforest :: Show a => Forest a -> String
|
||||||
showforest = concatMap showtree
|
showforest = concatMap showtree
|
||||||
|
|
||||||
|
|
||||||
|
-- | An efficient-to-build tree suggested by Cale Gibbard, probably
|
||||||
|
-- better than accountNameTreeFrom.
|
||||||
|
newtype FastTree a = T (M.Map a (FastTree a))
|
||||||
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
emptyTree = T M.empty
|
||||||
|
|
||||||
|
mergeTrees :: (Ord a) => FastTree a -> FastTree a -> FastTree a
|
||||||
|
mergeTrees (T m) (T m') = T (M.unionWith mergeTrees m m')
|
||||||
|
|
||||||
|
treeFromPath :: [a] -> FastTree a
|
||||||
|
treeFromPath [] = T M.empty
|
||||||
|
treeFromPath (x:xs) = T (M.singleton x (treeFromPath xs))
|
||||||
|
|
||||||
|
treeFromPaths :: (Ord a) => [[a]] -> FastTree a
|
||||||
|
treeFromPaths = foldl' mergeTrees emptyTree . map treeFromPath
|
||||||
|
|
||||||
|
|
||||||
-- debugging
|
-- debugging
|
||||||
|
|
||||||
-- | trace (print on stdout at runtime) a showable expression
|
-- | trace (print on stdout at runtime) a showable expression
|
||||||
|
|||||||
@ -269,7 +269,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
|
|||||||
<td>
|
<td>
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
l = journalToLedger Any j
|
l = ledgerFromJournal Any j
|
||||||
inacctmatcher = inAccountQuery qopts
|
inacctmatcher = inAccountQuery qopts
|
||||||
allaccts = isNothing inacctmatcher
|
allaccts = isNothing inacctmatcher
|
||||||
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
||||||
|
|||||||
@ -133,11 +133,6 @@ tests_Hledger_Cli = TestList
|
|||||||
|
|
||||||
,"show hours" ~: showAmount (hours 1) ~?= "1.0h"
|
,"show hours" ~: showAmount (hours 1) ~?= "1.0h"
|
||||||
|
|
||||||
,"subAccounts" ~: do
|
|
||||||
let l = journalToLedger Any samplejournal
|
|
||||||
a = ledgerAccount l "assets"
|
|
||||||
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
|
|
||||||
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
@ -539,7 +534,7 @@ journal7 = Journal
|
|||||||
[]
|
[]
|
||||||
(TOD 0 0)
|
(TOD 0 0)
|
||||||
|
|
||||||
ledger7 = journalToLedger Any journal7
|
ledger7 = ledgerFromJournal Any journal7
|
||||||
|
|
||||||
-- journal8_str = unlines
|
-- journal8_str = unlines
|
||||||
-- ["2008/1/1 test "
|
-- ["2008/1/1 test "
|
||||||
|
|||||||
@ -24,7 +24,6 @@ import System.IO ( stderr, hPutStrLn, hPutStr )
|
|||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import qualified Data.Foldable as Foldable (find)
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
@ -88,9 +87,9 @@ getTransaction j opts defaultDate = do
|
|||||||
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
|
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
|
||||||
accept x = x == "." || (not . null) x &&
|
accept x = x == "." || (not . null) x &&
|
||||||
if no_new_accounts_ opts
|
if no_new_accounts_ opts
|
||||||
then isJust $ Foldable.find (== x) ant
|
then x `elem` existingaccts
|
||||||
else True
|
else True
|
||||||
where (ant,_,_,_) = groupPostings $ journalPostings j
|
existingaccts = journalAccountNames j
|
||||||
getpostingsandvalidate = do
|
getpostingsandvalidate = do
|
||||||
ps <- getPostings (PostingState j accept True bestmatchpostings) []
|
ps <- getPostings (PostingState j accept True bestmatchpostings) []
|
||||||
let t = nulltransaction{tdate=date
|
let t = nulltransaction{tdate=date
|
||||||
|
|||||||
@ -25,7 +25,7 @@ stats :: CliOpts -> Journal -> IO ()
|
|||||||
stats CliOpts{reportopts_=reportopts_} j = do
|
stats CliOpts{reportopts_=reportopts_} j = do
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
let q = queryFromOpts d reportopts_
|
let q = queryFromOpts d reportopts_
|
||||||
l = journalToLedger q j
|
l = ledgerFromJournal q j
|
||||||
reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q)
|
reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q)
|
||||||
intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
|
intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
|
||||||
showstats = showLedgerStats l d
|
showstats = showLedgerStats l d
|
||||||
@ -58,7 +58,7 @@ showLedgerStats l today span =
|
|||||||
-- Days since last transaction : %(recentelapsed)s
|
-- Days since last transaction : %(recentelapsed)s
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
j = ledgerJournal l
|
j = ljournal l
|
||||||
path = journalFilePath j
|
path = journalFilePath j
|
||||||
ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j
|
ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j
|
||||||
as = nub $ map paccount $ concatMap tpostings ts
|
as = nub $ map paccount $ concatMap tpostings ts
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user