web: acct: -> in:/inacct:, match only one account (CI exact string match on full name), old acct: re-enabled

This commit is contained in:
Simon Michael 2011-06-08 22:02:49 +00:00
parent 2e754b79a2
commit 9734ed47a6
3 changed files with 23 additions and 15 deletions

View File

@ -38,7 +38,7 @@ data Matcher = MatchAny -- ^ always 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
| MatchAcct Bool String -- ^ match postings whose account 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 | MatchInAcct Bool String -- ^ XXX match postings whose transaction contains a posting to an account matching this regexp
| MatchDate Bool DateSpan -- ^ match if actual date in this date span | MatchDate Bool DateSpan -- ^ match if actual date in this date span
| MatchEDate Bool DateSpan -- ^ match if effective date in this date span | MatchEDate Bool DateSpan -- ^ match if effective date in this date span
| MatchStatus Bool Bool -- ^ match if cleared status has this value | MatchStatus Bool Bool -- ^ match if cleared status has this value
@ -54,8 +54,9 @@ parseMatcher refdate s = MatchAnd $ map parseword $ words'' ["not:","acct:","des
parseword :: String -> Matcher parseword :: String -> Matcher
parseword ('n':'o':'t':':':s) = negateMatch $ parseMatcher refdate s parseword ('n':'o':'t':':':s) = negateMatch $ parseMatcher refdate s
parseword ('d':'e':'s':'c':':':s) = MatchDesc True s parseword ('d':'e':'s':'c':':':s) = MatchDesc True s
-- parseword ('a':'c':'c':'t':':':s) = MatchAcct True s parseword ('a':'c':'c':'t':':':s) = MatchAcct True s
parseword ('a':'c':'c':'t':':':s) = MatchOtherAcct True s parseword ('i':'n':'a':'c':'c':'t':':':s) = MatchInAcct True s
parseword ('i':'n':':':s) = MatchInAcct True s
parseword ('d':'a':'t':'e':':':s) = MatchDate True $ spanFromSmartDateString refdate 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 ('e':'d':'a':'t':'e':':':s) = MatchEDate True $ spanFromSmartDateString refdate s
parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus s parseword ('s':'t':'a':'t':'u':'s':':':s) = MatchStatus True $ parseStatus s
@ -63,7 +64,7 @@ parseMatcher refdate s = MatchAnd $ map parseword $ words'' ["not:","acct:","des
parseword ('e':'m':'p':'t':'y':':':s) = MatchEmpty 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 ('d':'e':'p':'t':'h':':':s) = MatchDepth True $ readDef 0 s
parseword "" = MatchAny parseword "" = MatchAny
parseword s = parseword $ "acct:"++s parseword s = parseword $ "in:"++s
parseStatus "*" = True parseStatus "*" = True
parseStatus _ = False parseStatus _ = False
@ -104,11 +105,11 @@ matchesPosting (MatchDesc True r) p = regexMatchesCI r $ maybe "" tdescription $
matchesPosting (MatchDesc False r) p = not $ (MatchDesc True r) `matchesPosting` p matchesPosting (MatchDesc False r) p = not $ (MatchDesc True r) `matchesPosting` p
matchesPosting (MatchAcct True r) p = regexMatchesCI r $ paccount p matchesPosting (MatchAcct True r) p = regexMatchesCI r $ paccount p
matchesPosting (MatchAcct False r) p = not $ (MatchAcct True r) `matchesPosting` p matchesPosting (MatchAcct False r) p = not $ (MatchAcct True r) `matchesPosting` p
matchesPosting (MatchOtherAcct True r) p = matchesPosting (MatchInAcct True r) p =
case ptransaction p of case ptransaction p of
Just t -> (MatchAcct True r) `matchesTransaction` t && (MatchAcct False r) `matchesPosting` p Just t -> (MatchAcct True r) `matchesTransaction` t && (MatchAcct False r) `matchesPosting` p
Nothing -> False Nothing -> False
matchesPosting (MatchOtherAcct False r) p = not $ (MatchOtherAcct True r) `matchesPosting` p matchesPosting (MatchInAcct False r) p = not $ (MatchInAcct True r) `matchesPosting` p
matchesPosting _ _ = False matchesPosting _ _ = False
matchesTransaction :: Matcher -> Transaction -> Bool matchesTransaction :: Matcher -> Transaction -> Bool
@ -119,16 +120,17 @@ matchesTransaction (MatchDesc True r) t = regexMatchesCI r $ tdescription t
matchesTransaction (MatchDesc False r) t = not $ (MatchDesc True r) `matchesTransaction` t matchesTransaction (MatchDesc False r) t = not $ (MatchDesc True r) `matchesTransaction` t
matchesTransaction m@(MatchAcct True _) t = any (m `matchesPosting`) $ tpostings t matchesTransaction m@(MatchAcct True _) t = any (m `matchesPosting`) $ tpostings t
matchesTransaction (MatchAcct False r) t = not $ (MatchAcct True r) `matchesTransaction` t matchesTransaction (MatchAcct False r) t = not $ (MatchAcct True r) `matchesTransaction` t
matchesTransaction (MatchOtherAcct sense r) t = (MatchAcct sense r) `matchesTransaction` t matchesTransaction (MatchInAcct sense r) t = (MatchAcct sense r) `matchesTransaction` t
matchesTransaction _ _ = False matchesTransaction _ _ = False
-- | Does this matcher match this account name as one we are "in" ? -- | Does this matcher specify this account as the one we are "in" ?
-- For now, does a case-insensitive exact string match on the full account name.
matchesInAccount :: Matcher -> AccountName -> Bool matchesInAccount :: Matcher -> AccountName -> Bool
matchesInAccount (MatchAny) a = True matchesInAccount (MatchAny) a = True
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 (MatchOtherAcct True r) a = regexMatchesCI r a matchesInAccount (MatchInAcct True r) a = lowercase r == lowercase a -- regexMatchesCI r a
matchesInAccount (MatchOtherAcct False r) a = not $ (MatchOtherAcct True r) `matchesInAccount` a matchesInAccount (MatchInAcct False r) a = not $ (MatchInAcct True r) `matchesInAccount` a
matchesInAccount _ _ = True matchesInAccount _ _ = True
negateMatch :: Matcher -> Matcher negateMatch :: Matcher -> Matcher
@ -136,7 +138,7 @@ 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
negateMatch (MatchDesc sense arg) = MatchDesc (not sense) arg negateMatch (MatchDesc sense arg) = MatchDesc (not sense) arg
negateMatch (MatchOtherAcct sense arg) = MatchOtherAcct (not sense) arg negateMatch (MatchInAcct sense arg) = MatchInAcct (not sense) arg
negateMatch (MatchDate sense arg) = MatchDate (not sense) arg negateMatch (MatchDate sense arg) = MatchDate (not sense) arg
negateMatch (MatchEDate sense arg) = MatchEDate (not sense) arg negateMatch (MatchEDate sense arg) = MatchEDate (not sense) arg
negateMatch (MatchStatus sense arg) = MatchStatus (not sense) arg negateMatch (MatchStatus sense arg) = MatchStatus (not sense) arg

View File

@ -15,6 +15,7 @@ import Data.List
import Data.Maybe import Data.Maybe
import Data.Text(Text,pack,unpack) import Data.Text(Text,pack,unpack)
import Data.Time.Calendar import Data.Time.Calendar
import Safe
import System.FilePath (takeFileName, (</>)) import System.FilePath (takeFileName, (</>))
import System.IO.Storage (putValue, getValue) import System.IO.Storage (putValue, getValue)
import Text.Hamlet hiding (hamletFile) import Text.Hamlet hiding (hamletFile)
@ -122,19 +123,20 @@ getAccountsJsonR = do
-- helpers -- helpers
accountUrl a = "acct:" ++ quoteIfSpaced (accountNameToAccountRegex a) accountUrl :: String -> String
accountUrl a = "in:" ++ quoteIfSpaced (accountNameToAccountRegex a)
-- | Render a balance report as HTML. -- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,j=j} (items,total) = $(Settings.hamletFile "balancereport") balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,j=j} (items,total) = $(Settings.hamletFile "balancereport")
where where
filtering = not $ null q filtering = not $ null q
inaccts = filter (m `matchesInAccount`) $ journalAccountNames j inacct = headMay $ filter (m `matchesInAccount`) $ journalAccountNames j
itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute
itemAsHtml VD{here=here,q=q} (acct, adisplay, aindent, abal) = $(Settings.hamletFile "balancereportitem") itemAsHtml VD{here=here,q=q} (acct, adisplay, aindent, abal) = $(Settings.hamletFile "balancereportitem")
where where
depthclass = "depth"++show aindent depthclass = "depth"++show aindent
inclass = if acct `elem` inaccts then "inacct" else "notinacct" :: String inclass = if acct == inacct then "inacct" else "notinacct" :: String
indent = preEscapedString $ concat $ replicate (2 * aindent) "&nbsp;" indent = preEscapedString $ concat $ replicate (2 * aindent) "&nbsp;"
accturl = (here, [("q", pack $ accountUrl acct)]) accturl = (here, [("q", pack $ accountUrl acct)])
@ -379,7 +381,7 @@ journalselect journalfiles = $(Settings.hamletFile "journalselect")
-- utilities -- utilities
nulltemplate :: Hamlet AppRoute nulltemplate :: Hamlet AppRoute
nulltemplate = [hamlet||] nulltemplate = [$hamlet||]
-- | A bundle of data useful for handlers and their templates. -- | A bundle of data useful for handlers and their templates.
data ViewData = VD { data ViewData = VD {

View File

@ -241,3 +241,7 @@ tests_Hledger_Cli_Register = TestList
-- ] -- ]
] ]
--------------------------------------------------------------------------------
-- register mode 2: realistic account register