mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-28 04:46:31 +03:00
account register balance not right.. more fixes and plans
This commit is contained in:
parent
c9c6be27c0
commit
06331c71a8
@ -36,6 +36,7 @@ import Hledger.Data.Dates
|
|||||||
-- If the first boolean is False, it's an inverse match.
|
-- If the first boolean is False, it's an inverse match.
|
||||||
-- Currently used by hledger-web, will probably also replace FilterSpec at some point.
|
-- Currently used by hledger-web, will probably also replace FilterSpec at some point.
|
||||||
data Matcher = MatchAny -- ^ always match
|
data Matcher = MatchAny -- ^ always match
|
||||||
|
| MatchNone -- ^ never match
|
||||||
| MatchOr [Matcher] -- ^ match if any of these match
|
| MatchOr [Matcher] -- ^ match if any of these match
|
||||||
| MatchAnd [Matcher] -- ^ match if all of these match
|
| MatchAnd [Matcher] -- ^ match if all of these match
|
||||||
| MatchDesc Bool String -- ^ match if description matches this regexp
|
| MatchDesc Bool String -- ^ match if description matches this regexp
|
||||||
@ -50,8 +51,22 @@ data Matcher = MatchAny -- ^ always match
|
|||||||
| MatchInAcct Bool String -- ^ a flag indicating account register mode
|
| MatchInAcct Bool String -- ^ a flag indicating account register mode
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Parse a query expression string as a list of match patterns OR'd together.
|
-- | Convert a query expression containing zero or more space-separated
|
||||||
-- The current date is required to interpret relative dates.
|
-- search terms to a matcher and list of modifiers (TODO). A search term is either:
|
||||||
|
--
|
||||||
|
-- 1. a match criteria, used to select transactions. This is usually a prefixed pattern such as:
|
||||||
|
-- - acct:REGEXP
|
||||||
|
-- - date:PERIODEXP
|
||||||
|
-- - not:desc:REGEXP
|
||||||
|
--
|
||||||
|
-- 2. a modifier, that changes behaviour in some other way. There is currently one of these:
|
||||||
|
-- - inacct:FULLACCTNAME - should appear only once
|
||||||
|
--
|
||||||
|
-- When a pattern contains spaces, it or the whole term should be enclosed in single or double quotes.
|
||||||
|
-- Multiple terms are AND'ed together.
|
||||||
|
-- A reference date is required to interpret relative dates in period expressions.
|
||||||
|
--
|
||||||
|
-- parseMatcher :: Day -> String -> (Matcher,[Modifier])
|
||||||
parseMatcher :: Day -> String -> Matcher
|
parseMatcher :: Day -> String -> Matcher
|
||||||
parseMatcher refdate s = m
|
parseMatcher refdate s = m
|
||||||
where
|
where
|
||||||
@ -71,10 +86,10 @@ parseMatcher refdate s = m
|
|||||||
parseword ('i':'n':'a':'c':'c':'t':':':s) = MatchInAcct True s
|
parseword ('i':'n':'a':'c':'c':'t':':':s) = MatchInAcct True s
|
||||||
parseword ('i':'n':':':s) = MatchInAcct True s
|
parseword ('i':'n':':':s) = MatchInAcct True s
|
||||||
parseword ('d':'a':'t':'e':':':s) =
|
parseword ('d':'a':'t':'e':':':s) =
|
||||||
case parsePeriodExpr refdate s of Left _ -> MatchAnd [] -- XXX warn
|
case parsePeriodExpr refdate s of Left _ -> MatchNone -- XXX warn
|
||||||
Right (_,span) -> MatchDate True span
|
Right (_,span) -> MatchDate True span
|
||||||
parseword ('e':'d':'a':'t':'e':':':s) =
|
parseword ('e':'d':'a':'t':'e':':':s) =
|
||||||
case parsePeriodExpr refdate s of Left _ -> MatchAnd [] -- XXX warn
|
case parsePeriodExpr refdate s of Left _ -> MatchNone -- XXX warn
|
||||||
Right (_,span) -> MatchEDate True span
|
Right (_,span) -> MatchEDate True span
|
||||||
parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus s
|
parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus s
|
||||||
parseword ('r':'e':'a':'l':':':s) = MatchReal True $ parseBool s
|
parseword ('r':'e':'a':'l':':':s) = MatchReal True $ parseBool s
|
||||||
@ -92,7 +107,7 @@ parseMatcher refdate s = m
|
|||||||
-- are inside quotes, including quotes which may have one of the specified
|
-- are inside quotes, including quotes which may have one of the specified
|
||||||
-- prefixes in front, and maybe an additional not: prefix in front of that.
|
-- prefixes in front, and maybe an additional not: prefix in front of that.
|
||||||
words'' :: [String] -> String -> [String]
|
words'' :: [String] -> String -> [String]
|
||||||
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases
|
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
|
||||||
where
|
where
|
||||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, quotedPattern, pattern] `sepBy` many1 spacenonewline
|
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, quotedPattern, pattern] `sepBy` many1 spacenonewline
|
||||||
prefixedQuotedPattern = do
|
prefixedQuotedPattern = do
|
||||||
@ -117,7 +132,8 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases
|
|||||||
|
|
||||||
-- | Convert a match expression to its inverse.
|
-- | Convert a match expression to its inverse.
|
||||||
negateMatch :: Matcher -> Matcher
|
negateMatch :: Matcher -> Matcher
|
||||||
negateMatch MatchAny = MatchOr [] -- matches nothing
|
negateMatch MatchAny = MatchNone
|
||||||
|
negateMatch MatchNone = MatchAny
|
||||||
negateMatch (MatchOr ms) = MatchAnd $ map negateMatch ms
|
negateMatch (MatchOr ms) = MatchAnd $ map negateMatch ms
|
||||||
negateMatch (MatchAnd ms) = MatchOr $ map negateMatch ms
|
negateMatch (MatchAnd ms) = MatchOr $ map negateMatch ms
|
||||||
negateMatch (MatchAcct sense arg) = MatchAcct (not sense) arg
|
negateMatch (MatchAcct sense arg) = MatchAcct (not sense) arg
|
||||||
@ -133,6 +149,7 @@ negateMatch (MatchDepth sense arg) = MatchDepth (not sense) arg
|
|||||||
-- | Does the match expression match this posting ?
|
-- | Does the match expression match this posting ?
|
||||||
matchesPosting :: Matcher -> Posting -> Bool
|
matchesPosting :: Matcher -> Posting -> Bool
|
||||||
matchesPosting (MatchAny) _ = True
|
matchesPosting (MatchAny) _ = True
|
||||||
|
matchesPosting (MatchNone) _ = False
|
||||||
matchesPosting (MatchOr ms) p = any (`matchesPosting` p) ms
|
matchesPosting (MatchOr ms) p = any (`matchesPosting` p) ms
|
||||||
matchesPosting (MatchAnd ms) p = all (`matchesPosting` p) ms
|
matchesPosting (MatchAnd ms) p = all (`matchesPosting` p) ms
|
||||||
matchesPosting (MatchDesc True r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p
|
matchesPosting (MatchDesc True r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p
|
||||||
@ -159,6 +176,7 @@ matchesPosting _ _ = False
|
|||||||
-- | Does the match expression match this transaction ?
|
-- | Does the match expression match this transaction ?
|
||||||
matchesTransaction :: Matcher -> Transaction -> Bool
|
matchesTransaction :: Matcher -> Transaction -> Bool
|
||||||
matchesTransaction (MatchAny) _ = True
|
matchesTransaction (MatchAny) _ = True
|
||||||
|
matchesTransaction (MatchNone) _ = False
|
||||||
matchesTransaction (MatchOr ms) t = any (`matchesTransaction` t) ms
|
matchesTransaction (MatchOr ms) t = any (`matchesTransaction` t) ms
|
||||||
matchesTransaction (MatchAnd ms) t = all (`matchesTransaction` t) ms
|
matchesTransaction (MatchAnd ms) t = all (`matchesTransaction` t) ms
|
||||||
matchesTransaction (MatchDesc True r) t = regexMatchesCI r $ tdescription t
|
matchesTransaction (MatchDesc True r) t = regexMatchesCI r $ tdescription t
|
||||||
@ -177,6 +195,7 @@ matchesTransaction _ _ = False
|
|||||||
-- A matching in: clause is also considered a match.
|
-- A matching in: clause is also considered a match.
|
||||||
matchesAccount :: Matcher -> AccountName -> Bool
|
matchesAccount :: Matcher -> AccountName -> Bool
|
||||||
matchesAccount (MatchAny) _ = True
|
matchesAccount (MatchAny) _ = True
|
||||||
|
matchesAccount (MatchNone) _ = False
|
||||||
matchesAccount (MatchOr ms) a = any (`matchesAccount` a) ms
|
matchesAccount (MatchOr ms) a = any (`matchesAccount` a) ms
|
||||||
matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms
|
matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms
|
||||||
matchesAccount (MatchAcct True r) a = regexMatchesCI r a
|
matchesAccount (MatchAcct True r) a = regexMatchesCI r a
|
||||||
@ -189,6 +208,7 @@ matchesAccount _ _ = False
|
|||||||
-- XXX perhaps in: should be handled separately.
|
-- XXX perhaps in: should be handled separately.
|
||||||
matchesInAccount :: Matcher -> AccountName -> Bool
|
matchesInAccount :: Matcher -> AccountName -> Bool
|
||||||
matchesInAccount (MatchAny) _ = True
|
matchesInAccount (MatchAny) _ = True
|
||||||
|
matchesInAccount (MatchNone) _ = False
|
||||||
matchesInAccount (MatchOr ms) a = any (`matchesInAccount` a) ms
|
matchesInAccount (MatchOr ms) a = any (`matchesInAccount` a) ms
|
||||||
matchesInAccount (MatchAnd ms) a = all (`matchesInAccount` a) ms
|
matchesInAccount (MatchAnd ms) a = all (`matchesInAccount` a) ms
|
||||||
matchesInAccount (MatchInAcct True s) a = lowercase s == lowercase a -- regexMatchesCI r a
|
matchesInAccount (MatchInAcct True s) a = lowercase s == lowercase a -- regexMatchesCI r a
|
||||||
@ -202,7 +222,7 @@ matcherInAccount (MatchOr ms) = case catMaybes $ map matcherInAccount ms of
|
|||||||
(a:as@(_:_)) -> if all (==a) as then Just a else Nothing
|
(a:as@(_:_)) -> if all (==a) as then Just a else Nothing
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
matcherInAccount (MatchAnd ms) = headDef Nothing $ map Just $ catMaybes $ map matcherInAccount ms
|
matcherInAccount (MatchAnd ms) = headDef Nothing $ map Just $ catMaybes $ map matcherInAccount ms
|
||||||
matcherInAccount (MatchInAcct True a) = Just $ strace a
|
matcherInAccount (MatchInAcct True a) = Just a
|
||||||
matcherInAccount _ = Nothing
|
matcherInAccount _ = Nothing
|
||||||
|
|
||||||
-- | What start date does this matcher specify, if any ?
|
-- | What start date does this matcher specify, if any ?
|
||||||
@ -237,9 +257,12 @@ tests_Hledger_Data_Matching = TestList
|
|||||||
parseMatcher d "a" `is` (MatchAcct True "a")
|
parseMatcher d "a" `is` (MatchAcct True "a")
|
||||||
parseMatcher d "acct:a" `is` (MatchAcct True "a")
|
parseMatcher d "acct:a" `is` (MatchAcct True "a")
|
||||||
parseMatcher d "acct:a desc:b" `is` (MatchAnd [MatchAcct True "a", MatchDesc True "b"])
|
parseMatcher d "acct:a desc:b" `is` (MatchAnd [MatchAcct True "a", MatchDesc True "b"])
|
||||||
parseMatcher d "inacct:'expenses:autres d\233penses'" `is` (MatchInAcct True "expenses:autres d\233penses")
|
parseMatcher d "\"acct:expenses:autres d\233penses\"" `is` (MatchAcct True "expenses:autres d\233penses")
|
||||||
parseMatcher d "not:desc:'a b'" `is` (MatchDesc False "a b")
|
parseMatcher d "not:desc:'a b'" `is` (MatchDesc False "a b")
|
||||||
|
|
||||||
|
parseMatcher d "inacct:a desc:b" `is` (MatchAnd [MatchInAcct True "a", MatchDesc True "b"])
|
||||||
|
parseMatcher d "inacct:a inacct:b" `is` (MatchAnd [MatchInAcct True "a", MatchInAcct True "b"])
|
||||||
|
|
||||||
,"matchesAccount" ~: do
|
,"matchesAccount" ~: do
|
||||||
assertBool "positive acct match" $ matchesAccount (MatchAcct True "b:c") "a:bb:c:d"
|
assertBool "positive acct match" $ matchesAccount (MatchAcct True "b:c") "a:bb:c:d"
|
||||||
-- assertBool "acct should match at beginning" $ not $ matchesAccount (MatchAcct True "a:b") "c:a:b"
|
-- assertBool "acct should match at beginning" $ not $ matchesAccount (MatchAcct True "a:b") "c:a:b"
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
<td
|
<td
|
||||||
<td
|
<td
|
||||||
leave blank to see general journal (all postings)<br>
|
leave blank to see general journal (all postings)<br>
|
||||||
|
inacct:FULLACCTNAME (just one) or click an account to see transactions and accurate balance in a single account<br>
|
||||||
acct:REGEXP to see postings to matched accounts, desc:REGEXP to search by description<br>
|
acct:REGEXP to see postings to matched accounts, desc:REGEXP to search by description<br>
|
||||||
date:PERIODEXP or edate:PERIODEXP to match by date or effective date<br>
|
date:PERIODEXP or edate:PERIODEXP to match by date or effective date<br>
|
||||||
inacct:FULLACCTNAME or click an account to see transactions and accurate balance in a single account<br>
|
|
||||||
not: to negate, single or double quotes to include spaces, multiple patterns are AND'ed
|
not: to negate, single or double quotes to include spaces, multiple patterns are AND'ed
|
||||||
|
@ -111,13 +111,17 @@ accountRegisterReport _ j m a = postingsToRegisterReportItems ps nullposting sta
|
|||||||
ps = displayps
|
ps = displayps
|
||||||
-- ps | interval == NoInterval = displayps
|
-- ps | interval == NoInterval = displayps
|
||||||
-- | otherwise = summarisePostingsByInterval interval depth empty filterspan displayps
|
-- | otherwise = summarisePostingsByInterval interval depth empty filterspan displayps
|
||||||
|
a' = accountNameToAccountOnlyRegex a
|
||||||
|
-- XXX priorps and displayps not right due to inacct: still in matcher
|
||||||
-- postings to display: this account's transactions' "other" postings, filtered
|
-- postings to display: this account's transactions' "other" postings, filtered
|
||||||
-- same matcher used on transactions then again on postings, ok I think
|
-- same matcher used on transactions then again on postings, ok I think
|
||||||
ts = filter (matchesTransaction (MatchInAcct True $ accountNameToAccountOnlyRegex a)) $ jtxns j
|
ts = filter (matchesTransaction (MatchInAcct True a')) $ jtxns j
|
||||||
displayps = filter (matchesPosting (MatchAnd [MatchAcct False a, m])) $ transactionsPostings ts
|
displaymatcher = (MatchAnd [MatchAcct False a', m])
|
||||||
|
displayps = filter (matchesPosting displaymatcher) $ transactionsPostings ts
|
||||||
-- starting balance: sum of this account's unfiltered postings prior to the specified start date, if any
|
-- starting balance: sum of this account's unfiltered postings prior to the specified start date, if any
|
||||||
startdate = matcherStartDate m
|
priormatcher = case matcherStartDate m of
|
||||||
priormatcher = MatchAnd [MatchDate True (DateSpan Nothing startdate), MatchAcct True a]
|
Nothing -> MatchNone
|
||||||
|
d -> MatchAnd [MatchDate True (DateSpan Nothing d), MatchAcct True a']
|
||||||
priorps = filter (matchesPosting priormatcher) $ journalPostings j
|
priorps = filter (matchesPosting priormatcher) $ journalPostings j
|
||||||
startbal = sumPostings priorps
|
startbal = sumPostings priorps
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user