account register balance not right.. more fixes and plans

This commit is contained in:
Simon Michael 2011-06-12 22:35:54 +00:00
parent c9c6be27c0
commit 06331c71a8
3 changed files with 40 additions and 13 deletions

View File

@ -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"

View File

@ -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

View File

@ -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