account register balance not right.. more fixes and plans

2011-06-12 22:35:54 +00:00 · 2011-06-12 22:35:54 +00:00 · 06331c71a8
commit 06331c71a8
parent c9c6be27c0
3 changed files with 40 additions and 13 deletions
--- a/hledger-lib/Hledger/Data/Matching.hs
+++ b/hledger-lib/Hledger/Data/Matching.hs
@ -36,6 +36,7 @@ import Hledger.Data.Dates
 -- If the first boolean is False, it's an inverse match.
 -- Currently used by hledger-web, will probably also replace FilterSpec at some point.
 data Matcher = MatchAny                   -- ^ always match
+             | MatchNone                  -- ^ never match
             | MatchOr [Matcher]          -- ^ match if any of these match
             | MatchAnd [Matcher]         -- ^ match if all of these match
             | 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
    deriving (Show, Eq)

-- | Parse a query expression string as a list of match patterns OR'd together.
-- The current date is required to interpret relative dates.
+-- | Convert a query expression containing zero or more space-separated
+-- 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 refdate s = m
  where
@ -71,10 +86,10 @@ parseMatcher refdate s = m
    parseword ('i':'n':'a':'c':'c':'t':':':s) = MatchInAcct True s
    parseword ('i':'n':':':s)                 = MatchInAcct True 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
    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
    parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus 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
 -- prefixes in front, and maybe an additional not: prefix in front of that.
 words'' :: [String] -> String -> [String]
-words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases
+words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
    where
      maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, quotedPattern, pattern] `sepBy` many1 spacenonewline
      prefixedQuotedPattern = do
@ -117,7 +132,8 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases

 -- | Convert a match expression to its inverse.
 negateMatch :: Matcher -> Matcher
-negateMatch MatchAny                   = MatchOr [] -- matches nothing
+negateMatch MatchAny                   = MatchNone
+negateMatch MatchNone                  = MatchAny
 negateMatch (MatchOr ms)               = MatchAnd $ map negateMatch ms
 negateMatch (MatchAnd ms)              = MatchOr $ map negateMatch ms
 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 ?
 matchesPosting :: Matcher -> Posting -> Bool
 matchesPosting (MatchAny) _ = True
+matchesPosting (MatchNone) _ = False
 matchesPosting (MatchOr ms) p = any (`matchesPosting` p) ms
 matchesPosting (MatchAnd ms) p = all (`matchesPosting` p) ms
 matchesPosting (MatchDesc True r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p
@ -159,6 +176,7 @@ matchesPosting _ _ = False
 -- | Does the match expression match this transaction ?
 matchesTransaction :: Matcher -> Transaction -> Bool
 matchesTransaction (MatchAny) _ = True
+matchesTransaction (MatchNone) _ = False
 matchesTransaction (MatchOr ms) t = any (`matchesTransaction` t) ms
 matchesTransaction (MatchAnd ms) t = all (`matchesTransaction` t) ms
 matchesTransaction (MatchDesc True r) t = regexMatchesCI r $ tdescription t
@ -177,6 +195,7 @@ matchesTransaction _ _ = False
 -- A matching in: clause is also considered a match.
 matchesAccount :: Matcher -> AccountName -> Bool
 matchesAccount (MatchAny) _ = True
+matchesAccount (MatchNone) _ = False
 matchesAccount (MatchOr ms) a = any (`matchesAccount` a) ms
 matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms
 matchesAccount (MatchAcct True r) a = regexMatchesCI r a
@ -189,6 +208,7 @@ matchesAccount _ _ = False
 -- XXX perhaps in: should be handled separately.
 matchesInAccount :: Matcher -> AccountName -> Bool
 matchesInAccount (MatchAny) _ = True
+matchesInAccount (MatchNone) _ = False
 matchesInAccount (MatchOr ms) a = any (`matchesInAccount` a) ms
 matchesInAccount (MatchAnd ms) a = all (`matchesInAccount` a) ms
 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
                                  _ -> Nothing
 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

 -- | 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 "acct:a" `is` (MatchAcct True "a")
    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 "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
    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"
--- a/hledger-web/.hledger/web/templates/filterform.hamlet
+++ b/hledger-web/.hledger/web/templates/filterform.hamlet
@ -16,7 +16,7 @@
    <td
    <td
     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>
     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
--- a/hledger/Hledger/Cli/Register.hs
+++ b/hledger/Hledger/Cli/Register.hs
@ -111,13 +111,17 @@ accountRegisterReport _ j m a = postingsToRegisterReportItems ps nullposting sta
     ps = displayps
      -- ps | interval == NoInterval = 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
     -- same matcher used on transactions then again on postings, ok I think
-     ts = filter (matchesTransaction (MatchInAcct True $ accountNameToAccountOnlyRegex a)) $ jtxns j
-     displayps = filter (matchesPosting (MatchAnd [MatchAcct False a, m])) $ transactionsPostings ts
+     ts = filter (matchesTransaction (MatchInAcct True a')) $ jtxns j
+     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
-     startdate = matcherStartDate m
-     priormatcher = MatchAnd [MatchDate True (DateSpan Nothing startdate), MatchAcct True a]
+     priormatcher = case matcherStartDate m of
+                      Nothing -> MatchNone
+                      d       -> MatchAnd [MatchDate True (DateSpan Nothing d), MatchAcct True a']
     priorps = filter (matchesPosting priormatcher) $ journalPostings j
     startbal = sumPostings priorps