From f7956d1ab7efa2ed7cf136e8f69eed2967af955c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 7 Jun 2011 06:11:38 +0000 Subject: [PATCH] web: account matching works like --related by default; dim excluded accounts A step closer to working like standard accounting programs where you click an account to see transactions "in" that account. acct:PAT (or just PAT) now matches the other postings in transactions matching the account pattern, like ledger --related. When matching an account (or several) this way, the unmatched accounts are dimmed to clarify what's happening. Still to do: fix the sign of the running total, and find out how this style of search will really coexist with the other ways of searching. --- hledger-lib/Hledger/Data/Matching.hs | 33 +++++++++----- hledger-web/.hledger/web/static/style.css | 6 ++- .../web/templates/accountsheading.hamlet | 6 --- ...lds.hamlet => addformpostingfields.hamlet} | 0 ...mlet => addformpostingfieldsamount.hamlet} | 0 .../web/templates/balancereport.hamlet | 9 +++- .../web/templates/balancereportitem.hamlet | 4 +- .../.hledger/web/templates/filterform.hamlet | 14 ++++-- .../web/templates/filterformclear.hamlet | 1 - hledger-web/Handlers.hs | 43 ++++++------------- 10 files changed, 62 insertions(+), 54 deletions(-) delete mode 100644 hledger-web/.hledger/web/templates/accountsheading.hamlet rename hledger-web/.hledger/web/templates/{postingfields.hamlet => addformpostingfields.hamlet} (100%) rename hledger-web/.hledger/web/templates/{postingfieldsamount.hamlet => addformpostingfieldsamount.hamlet} (100%) delete mode 100644 hledger-web/.hledger/web/templates/filterformclear.hamlet diff --git a/hledger-lib/Hledger/Data/Matching.hs b/hledger-lib/Hledger/Data/Matching.hs index 10640aa65..1148660bf 100644 --- a/hledger-lib/Hledger/Data/Matching.hs +++ b/hledger-lib/Hledger/Data/Matching.hs @@ -33,8 +33,9 @@ import Hledger.Data.Dates -- | A more general way to match transactions and postings, successor to FilterSpec. (?) -- If the first boolean is False, it's a negative match. -data Matcher = MatchOr [Matcher] -- ^ match if any match - | MatchAnd [Matcher] -- ^ match if all match +data Matcher = MatchAny -- ^ always 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 | MatchAcct Bool String -- ^ match postings whose account matches this regexp | MatchOtherAcct Bool String -- ^ match postings whose transaction contains a posting to an account matching this regexp @@ -48,19 +49,20 @@ data Matcher = MatchOr [Matcher] -- ^ match if any match -- | Parse a query expression as a list of match patterns OR'd together. parseMatcher :: Day -> String -> Matcher -parseMatcher refdate s = MatchOr $ map parseword $ words'' ["otheracct:"] s +parseMatcher refdate s = MatchAnd $ map parseword $ words'' ["not:","acct:","desc:"] s where parseword :: String -> Matcher parseword ('n':'o':'t':':':s) = negateMatch $ parseMatcher refdate s parseword ('d':'e':'s':'c':':':s) = MatchDesc True s - parseword ('a':'c':'c':'t':':':s) = MatchAcct True s - parseword ('o':'t':'h':'e':'r':'a':'c':'c':'t':':':s) = MatchOtherAcct True s + -- parseword ('a':'c':'c':'t':':':s) = MatchAcct True s + parseword ('a':'c':'c':'t':':':s) = MatchOtherAcct True s parseword ('d':'a':'t':'e':':':s) = MatchDate True $ spanFromSmartDateString refdate s parseword ('e':'d':'a':'t':'e':':':s) = MatchEDate True $ spanFromSmartDateString refdate s parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus s parseword ('r':'e':'a':'l':':':s) = MatchReal True $ parseBool s parseword ('e':'m':'p':'t':'y':':':s) = MatchEmpty True $ parseBool s parseword ('d':'e':'p':'t':'h':':':s) = MatchDepth True $ readDef 0 s + parseword "" = MatchAny parseword s = parseword $ "acct:"++s parseStatus "*" = True @@ -86,7 +88,7 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- -- | Parse the query string as a boolean tree of match patterns. -- parseMatcher :: String -> Matcher --- parseMatcher s = either (const (MatchOr [])) id $ runParser matcher () "" $ lexmatcher s +-- parseMatcher s = either (const (MatchAny)) id $ runParser matcher () "" $ lexmatcher s -- lexmatcher :: String -> [String] -- lexmatcher s = words' s @@ -95,11 +97,12 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- matcher = undefined matchesPosting :: Matcher -> Posting -> Bool +matchesPosting (MatchAny) p = True matchesPosting (MatchOr ms) p = any (`matchesPosting` p) ms matchesPosting (MatchAnd ms) p = all (`matchesPosting` p) ms -matchesPosting (MatchDesc True r) p = regexMatches r $ maybe "" tdescription $ ptransaction p +matchesPosting (MatchDesc True r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p matchesPosting (MatchDesc False r) p = not $ (MatchDesc True r) `matchesPosting` p -matchesPosting (MatchAcct True r) p = regexMatches r $ paccount p +matchesPosting (MatchAcct True r) p = regexMatchesCI r $ paccount p matchesPosting (MatchAcct False r) p = not $ (MatchAcct True r) `matchesPosting` p matchesPosting (MatchOtherAcct True r) p = case ptransaction p of @@ -109,15 +112,25 @@ matchesPosting (MatchOtherAcct False r) p = not $ (MatchOtherAcct True r) `match matchesPosting _ _ = False matchesTransaction :: Matcher -> Transaction -> Bool +matchesTransaction (MatchAny) t = True matchesTransaction (MatchOr ms) t = any (`matchesTransaction` t) ms matchesTransaction (MatchAnd ms) t = all (`matchesTransaction` t) ms -matchesTransaction (MatchDesc True r) t = regexMatches r $ tdescription t +matchesTransaction (MatchDesc True r) t = regexMatchesCI r $ tdescription t matchesTransaction (MatchDesc False r) t = not $ (MatchDesc True r) `matchesTransaction` t matchesTransaction m@(MatchAcct True _) t = any (m `matchesPosting`) $ tpostings t matchesTransaction (MatchAcct False r) t = not $ (MatchAcct True r) `matchesTransaction` t -matchesTransaction m@(MatchOtherAcct sense r) t = (MatchAcct sense r) `matchesTransaction` t +matchesTransaction (MatchOtherAcct sense r) t = (MatchAcct sense r) `matchesTransaction` t matchesTransaction _ _ = False +-- | Does this matcher match this account name as one we are "in" ? +matchesInAccount :: Matcher -> AccountName -> Bool +matchesInAccount (MatchAny) a = True +matchesInAccount (MatchOr ms) a = any (`matchesInAccount` a) ms +matchesInAccount (MatchAnd ms) a = all (`matchesInAccount` a) ms +matchesInAccount (MatchOtherAcct True r) a = regexMatchesCI r a +matchesInAccount (MatchOtherAcct False r) a = not $ (MatchOtherAcct True r) `matchesInAccount` a +matchesInAccount _ _ = True + negateMatch :: Matcher -> Matcher negateMatch (MatchOr ms) = MatchAnd $ map negateMatch ms negateMatch (MatchAnd ms) = MatchOr $ map negateMatch ms diff --git a/hledger-web/.hledger/web/static/style.css b/hledger-web/.hledger/web/static/style.css index 063b736e1..bdb2b9ac8 100644 --- a/hledger-web/.hledger/web/static/style.css +++ b/hledger-web/.hledger/web/static/style.css @@ -17,10 +17,13 @@ body { backgroun /* #main { border-color:#eee; } see below */ /* .journalreport td { border-color:thin solid #eee; } see below */ -.negative { color:#800; } #message { color:red; background-color:#fee; } #addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list { background-color:#eee; } #editform textarea { background-color:#eee; } +.negative { color:#800; } + +.balancereport .inacct { /*background-color:#f0f0f0;*/ } +.notinacct, .notinacct :link, .notinacct :visited, .notinacct .negative { color:#aaa; } /*------------------------------------------------------------------------------------------*/ /* 2. font families & sizes */ @@ -93,6 +96,7 @@ table.journalreport { border-spacing: 0; } .balancereport tr { vertical-align:bottom; border-spacing:0; } .balancereport .title { white-space:nowrap; } .balancereport .item { } +.balancereport .depth0 { padding-top:1em; } .balancereport td { padding:0; } .totalrule td { border-top:thin solid black; } diff --git a/hledger-web/.hledger/web/templates/accountsheading.hamlet b/hledger-web/.hledger/web/templates/accountsheading.hamlet deleted file mode 100644 index cd224083e..000000000 --- a/hledger-web/.hledger/web/templates/accountsheading.hamlet +++ /dev/null @@ -1,6 +0,0 @@ -show all diff --git a/hledger-web/.hledger/web/templates/postingfields.hamlet b/hledger-web/.hledger/web/templates/addformpostingfields.hamlet similarity index 100% rename from hledger-web/.hledger/web/templates/postingfields.hamlet rename to hledger-web/.hledger/web/templates/addformpostingfields.hamlet diff --git a/hledger-web/.hledger/web/templates/postingfieldsamount.hamlet b/hledger-web/.hledger/web/templates/addformpostingfieldsamount.hamlet similarity index 100% rename from hledger-web/.hledger/web/templates/postingfieldsamount.hamlet rename to hledger-web/.hledger/web/templates/addformpostingfieldsamount.hamlet diff --git a/hledger-web/.hledger/web/templates/balancereport.hamlet b/hledger-web/.hledger/web/templates/balancereport.hamlet index 176ee607b..80cbbbd6d 100644 --- a/hledger-web/.hledger/web/templates/balancereport.hamlet +++ b/hledger-web/.hledger/web/templates/balancereport.hamlet @@ -1,7 +1,14 @@ -^{accountsheading} +show all + $forall i <- items ^{itemAsHtml vd i} + diff --git a/hledger-web/.hledger/web/templates/balancereportitem.hamlet b/hledger-web/.hledger/web/templates/balancereportitem.hamlet index 577ebf997..faac88cd0 100644 --- a/hledger-web/.hledger/web/templates/balancereportitem.hamlet +++ b/hledger-web/.hledger/web/templates/balancereportitem.hamlet @@ -1,5 +1,5 @@ -#{adisplay} #{mixedAmountAsHtml abal} diff --git a/hledger-web/.hledger/web/templates/filterform.hamlet b/hledger-web/.hledger/web/templates/filterform.hamlet index e785a6b4c..7f678e686 100644 --- a/hledger-web/.hledger/web/templates/filterform.hamlet +++ b/hledger-web/.hledger/web/templates/filterform.hamlet @@ -1,7 +1,7 @@ show all + + not: to negate, multiple patterns are AND'ed, patterns are regular expressions +
+ leave blank to see general journal (all postings) diff --git a/hledger-web/.hledger/web/templates/filterformclear.hamlet b/hledger-web/.hledger/web/templates/filterformclear.hamlet deleted file mode 100644 index 16c2dbb0b..000000000 --- a/hledger-web/.hledger/web/templates/filterformclear.hamlet +++ /dev/null @@ -1 +0,0 @@ -clear filter \ No newline at end of file diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs index 9788c41a5..7aca9874d 100644 --- a/hledger-web/Handlers.hs +++ b/hledger-web/Handlers.hs @@ -122,31 +122,21 @@ getAccountsJsonR = do -- helpers +accountUrl a = "acct:" ++ quoteIfSpaced (accountNameToAccountRegex a) + -- | Render a balance report as HTML. balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute -balanceReportAsHtml _ vd@VD{here=here,q=q} (items,total) = $(Settings.hamletFile "balancereport") +balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,j=j} (items,total) = $(Settings.hamletFile "balancereport") where + filtering = not $ null q + inaccts = filter (m `matchesInAccount`) $ journalAccountNames j itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute itemAsHtml VD{here=here,q=q} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem") where + depthclass = "depth"++show adepth + inclass = if acct `elem` inaccts then "inacct" else "notinacct" :: String indent = preEscapedString $ concat $ replicate (2 * adepth) " " - accturl = (here, [("q", pack $ "otheracct:" ++ quoteIfSpaced (accountNameToAccountRegex acct))]) - accountsheading = $(Settings.hamletFile "accountsheading") - where - filtering = not $ null q - -- showlinks = $(Settings.hamletFile "accountsheadinglinks") - -- showmore = case (filteringaccts, items) of - -- -- cunning parent account logic - -- (True, ((acct, _, _, _):_)) -> - -- let a' = if isAccountRegex a then a else acct - -- a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' - -- parenturl = (here, [("a",pack a''), ("p",pack p)]) - -- in $(Settings.hamletFile "accountsheadinglinksmore") - -- _ -> nulltemplate - -- showall = if filteringaccts - -- then $(Settings.hamletFile "accountsheadinglinksall") - -- else nulltemplate - -- where allurl = (here, []) + accturl = (here, [("q", pack $ accountUrl acct)]) -- | Render a journal report as HTML. journalReportAsHtml :: [Opt] -> ViewData -> JournalReport -> Hamlet AppRoute @@ -169,7 +159,7 @@ registerReportAsHtml _ vd items = $(Settings.hamletFile "registerreport") (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) Nothing -> ("", "", "") :: (String,String,String) acct = paccount posting - accturl = (here, [("q", pack $ "otheracct:" ++ quoteIfSpaced (accountNameToAccountRegex acct))]) + accturl = (here, [("q", pack $ accountUrl acct)]) mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ show b where addclass = printf "%s" (c :: String) @@ -342,14 +332,7 @@ helplink topic label = $(Settings.hamletFile "helplink") filterform :: ViewData -> Hamlet AppRoute filterform VD{here=here,q=q} = $(Settings.hamletFile "filterform") where - -- ahelp = helplink "filter-patterns" "?" - -- phelp = helplink "period-expressions" "?" filtering = not $ null q - visible = "block" :: String - filteringclass = if filtering then "filtering" else "" :: String - filteringperiodclass = "" :: String - stopfiltering = if filtering then $(Settings.hamletFile "filterformclear") else nulltemplate - where u = (here, []) -- | Add transaction form. addform :: ViewData -> Hamlet AppRoute @@ -360,7 +343,7 @@ addform vd = $(Settings.hamletFile "addform") date = "today" :: String descriptions = sort $ nub $ map tdescription $ jtxns $ j vd manyfiles = (length $ files $ j vd) > 1 - postingfields VD{j=j} n = $(Settings.hamletFile "postingfields") + postingfields VD{j=j} n = $(Settings.hamletFile "addformpostingfields") where numbered = (++ show n) acctvar = numbered "account" @@ -369,7 +352,7 @@ addform vd = $(Settings.hamletFile "addform") (acctlabel, accthelp, amtfield, amthelp) | n == 1 = ("To account" ,"eg: expenses:food" - ,$(Settings.hamletFile "postingfieldsamount") + ,$(Settings.hamletFile "addformpostingfieldsamount") ,"eg: $6" ) | otherwise = ("From account" :: String @@ -413,7 +396,7 @@ mkvd :: ViewData mkvd = VD { opts = [] ,q = "" - ,m = MatchOr [] + ,m = MatchAny ,j = nulljournal ,today = ModifiedJulianDay 0 ,here = RootR @@ -430,7 +413,7 @@ getViewData = do Just here' <- getCurrentRoute today <- liftIO getCurrentDay q <- getParameter "q" - let m = parseMatcher today q + let m = strace $ parseMatcher today q return mkvd{opts=opts, q=q, m=m, j=j, today=today, here=here', msg=msg} where -- | Update our copy of the journal if the file changed. If there is an