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.
This commit is contained in:
Simon Michael 2011-06-07 06:11:38 +00:00
parent 32a1b921df
commit f7956d1ab7
10 changed files with 62 additions and 54 deletions

View File

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

View File

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

View File

@ -1,6 +0,0 @@
<div#accountsheading
accounts
$if filtering
\ #
<span.showall
<a href=@{here}>show all

View File

@ -1,7 +1,14 @@
^{accountsheading}
<div#accountsheading
accounts
$if filtering
\ #
<span.showall
<a href=@{here}>show all
<table.balancereport>
$forall i <- items
^{itemAsHtml vd i}
<tr.totalrule>
<td colspan=2>
<tr>

View File

@ -1,5 +1,5 @@
<tr.item
<td.account
<tr.item.#{inclass}
<td.account.#{depthclass}
#{indent}
<a href="@?{accturl}">#{adisplay}
<td.balance align=right>#{mixedAmountAsHtml abal}

View File

@ -1,7 +1,7 @@
<div#filterformdiv
<form#filterform.form method=GET style=display:#{visible};
<table.form
<tr.#{filteringperiodclass}
<form#filterform.form method=GET
<table
<tr
<td
Search:
\ #
@ -11,3 +11,11 @@
\ #
<span.showall
<a href=@{here}>show all
<tr.help
<td
<td
PAT or acct:PAT to see transactions in all matched accounts, desc:PAT to search by description
<br>
not: to negate, multiple patterns are AND'ed, patterns are regular expressions
<br>
leave blank to see general journal (all postings)

View File

@ -1 +0,0 @@
<a#stopfilterlink href=@?{u}>clear filter

View File

@ -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) "&nbsp;"
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 "<br>" $ lines $ show b
where addclass = printf "<span class=\"%s\">%s</span>" (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