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