{-|
More generic matching, done in one step, unlike FilterSpec and filterJournal*.
Currently used only by hledger-web.
-}moduleHledger.Data.MatchingwhereimportData.EitherimportData.List-- import Data.Map (findWithDefault, (!))importData.Maybe-- import Data.OrdimportData.Time.Calendar-- import Data.Time.LocalTime-- import Data.TreeimportSafe(readDef,headDef)-- import System.Time (ClockTime(TOD))importTest.HUnitimportText.ParserCombinators.Parsec-- import Text.Printf-- import qualified Data.Map as MapimportHledger.UtilsimportHledger.Data.TypesimportHledger.Data.AccountNameimportHledger.Data.Amount-- import Hledger.Data.Commodity (canonicaliseCommodities)importHledger.Data.DatesimportHledger.Data.PostingimportHledger.Data.Transaction-- import Hledger.Data.TimeLog-- | A matcher is a single, or boolean composition of, search criteria,-- which can be used to match postings, transactions, accounts and more.-- Currently used by hledger-web, will likely replace FilterSpec at some point.dataMatcher=MatchAny-- ^ always match|MatchNone-- ^ never match|MatchNotMatcher-- ^ negate this match|MatchOr[Matcher]-- ^ match if any of these match|MatchAnd[Matcher]-- ^ match if all of these match|MatchDescString-- ^ match if description matches this regexp|MatchAcctString-- ^ match postings whose account matches this regexp|MatchDateDateSpan-- ^ match if actual date in this date span|MatchEDateDateSpan-- ^ match if effective date in this date span|MatchStatusBool-- ^ match if cleared status has this value|MatchRealBool-- ^ match if "realness" (involves a real non-virtual account ?) has this value|MatchEmptyBool-- ^ match if "emptiness" (from the --empty command-line flag) has this value.-- Currently this means a posting with zero amount.|MatchDepthInt-- ^ match if account depth is less than or equal to this valuederiving(Show,Eq)-- | A query option changes a query's/report's behaviour and output in some way.-- XXX could use regular CliOpts ?dataQueryOpt=QueryOptInAcctOnlyAccountName-- ^ show an account register focussed on this account|QueryOptInAcctAccountName-- ^ as above but include sub-accounts in the account register-- | QueryOptCostBasis -- ^ show amounts converted to cost where possible-- | QueryOptEffectiveDate -- ^ show effective dates instead of actual datesderiving(Show,Eq)-- | The account we are currently focussed on, if any, and whether subaccounts are included.-- Just looks at the first query option.inAccount::[QueryOpt]->Maybe(AccountName,Bool)inAccount[]=NothinginAccount(QueryOptInAcctOnlya:_)=Just(a,False)inAccount(QueryOptInAccta:_)=Just(a,True)-- | A matcher for the account(s) we are currently focussed on, if any.-- Just looks at the first query option.inAccountMatcher::[QueryOpt]->MaybeMatcherinAccountMatcher[]=NothinginAccountMatcher(QueryOptInAcctOnlya:_)=Just$MatchAcct$accountNameToAccountOnlyRegexainAccountMatcher(QueryOptInAccta:_)=Just$MatchAcct$accountNameToAccountRegexa-- -- | A matcher restricting the account(s) to be shown in the sidebar, if any.-- -- Just looks at the first query option.-- showAccountMatcher :: [QueryOpt] -> Maybe Matcher-- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ MatchAcct True $ accountNameToAccountRegex a-- showAccountMatcher _ = Nothing-- | Convert a query expression containing zero or more space-separated-- terms to a matcher and zero or more query options. A query term is either:---- 1. a search criteria, used to match transactions. This is usually a prefixed pattern such as:-- acct:REGEXP-- date:PERIODEXP-- not:desc:REGEXP---- 2. a query option, which changes behaviour in some way. There is currently one of these:-- inacct:FULLACCTNAME - should appear only once---- Multiple search criteria are AND'ed together.-- When a pattern contains spaces, it or the whole term should be enclosed in single or double quotes.-- A reference date is required to interpret relative dates in period expressions.--parseQuery::Day->String->(Matcher,[QueryOpt])parseQueryds=(m,qopts)whereterms=words''prefixess(matchers,qopts)=partitionEithers$map(parseMatcherd)termsm=casematchersof[]->MatchAny(m':[])->m'ms->MatchAndms-- | Quote-and-prefix-aware version of words - don't split on spaces which-- 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.parsewithmaybeprefixedquotedphrases-- XXXwheremaybeprefixedquotedphrases=choice'[prefixedQuotedPattern,quotedPattern,pattern]`sepBy`many1spacenonewlineprefixedQuotedPattern=donot'<-optionMaybe$string"not:"prefix<-choice'$mapstringprefixesp<-quotedPatternreturn$fromMaybe""not'++prefix++stripquotespquotedPattern=dop<-between(oneOf"'\"")(oneOf"'\"")$many$noneOf"'\""return$stripquotesppattern=many(noneOf" \n\r\"")-- -- | Parse the query string as a boolean tree of match patterns.-- parseMatcher :: String -> Matcher-- parseMatcher s = either (const (MatchAny)) id $ runParser matcher () "" $ lexmatcher s-- lexmatcher :: String -> [String]-- lexmatcher s = words' s-- matcher :: GenParser String () Matcher-- matcher = undefined-- keep synced with patterns below, excluding "not"prefixes=map(++":")["inacct","inacctonly","desc","acct","date","edate","status","real","empty","depth"]defaultprefix="acct"-- | Parse a single query term as either a matcher or a query option.parseMatcher::Day->String->EitherMatcherQueryOptparseMatcher_('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s)=Right$QueryOptInAcctOnlysparseMatcher_('i':'n':'a':'c':'c':'t':':':s)=Right$QueryOptInAcctsparseMatcherd('n':'o':'t':':':s)=caseparseMatcherdsofLeftm->Left$MatchNotmRight_->LeftMatchAny-- not:somequeryoption will be ignoredparseMatcher_('d':'e':'s':'c':':':s)=Left$MatchDescsparseMatcher_('a':'c':'c':'t':':':s)=Left$MatchAcctsparseMatcherd('d':'a':'t':'e':':':s)=caseparsePeriodExprdsofLeft_->LeftMatchNone-- XXX should warnRight(_,span)->Left$MatchDatespanparseMatcherd('e':'d':'a':'t':'e':':':s)=caseparsePeriodExprdsofLeft_->LeftMatchNone-- XXX should warnRight(_,span)->Left$MatchEDatespanparseMatcher_('s':'t':'a':'t':'u':'s':':':s)=Left$MatchStatus$parseStatussparseMatcher_('r':'e':'a':'l':':':s)=Left$MatchReal$parseBoolsparseMatcher_('e':'m':'p':'t':'y':':':s)=Left$MatchEmpty$parseBoolsparseMatcher_('d':'e':'p':'t':'h':':':s)=Left$MatchDepth$readDef0sparseMatcher_""=Left$MatchAnyparseMatcherds=parseMatcherd$defaultprefix++":"++s-- | Parse the boolean value part of a "status:" matcher, allowing "*" as-- another way to spell True, similar to the journal file format.parseStatus::String->BoolparseStatuss=s`elem`(truestrings++["*"])-- | Parse the boolean value part of a "status:" matcher. A true value can-- be spelled as "1", "t" or "true".parseBool::String->BoolparseBools=s`elem`truestringstruestrings::[String]truestrings=["1","t","true"]-- | Convert a match expression to its inverse.negateMatcher::Matcher->MatchernegateMatcher=MatchNot-- | Does the match expression match this posting ?matchesPosting::Matcher->Posting->BoolmatchesPosting(MatchNotm)p=not$matchesPostingmpmatchesPosting(MatchAny)_=TruematchesPosting(MatchNone)_=FalsematchesPosting(MatchOrms)p=any(`matchesPosting`p)msmatchesPosting(MatchAndms)p=all(`matchesPosting`p)msmatchesPosting(MatchDescr)p=regexMatchesCIr$maybe""tdescription$ptransactionpmatchesPosting(MatchAcctr)p=regexMatchesCIr$paccountpmatchesPosting(MatchDatespan)p=casedofJustd'->spanContainsDatespand'Nothing->Falsewhered=maybeNothing(Just.tdate)$ptransactionpmatchesPosting(MatchEDatespan)p=casepostingEffectiveDatepofJustd->spanContainsDatespandNothing->FalsematchesPosting(MatchStatusv)p=v==postingClearedpmatchesPosting(MatchRealv)p=v==isRealpmatchesPosting(MatchEmptyv)Posting{pamount=a}=v==isZeroMixedAmountamatchesPosting__=False-- | Does the match expression match this transaction ?matchesTransaction::Matcher->Transaction->BoolmatchesTransaction(MatchNotm)t=not$matchesTransactionmtmatchesTransaction(MatchAny)_=TruematchesTransaction(MatchNone)_=FalsematchesTransaction(MatchOrms)t=any(`matchesTransaction`t)msmatchesTransaction(MatchAndms)t=all(`matchesTransaction`t)msmatchesTransaction(MatchDescr)t=regexMatchesCIr$tdescriptiontmatchesTransactionm@(MatchAcct_)t=any(m`matchesPosting`)$tpostingstmatchesTransaction(MatchDatespan)t=spanContainsDatespan$tdatetmatchesTransaction(MatchEDatespan)t=spanContainsDatespan$transactionEffectiveDatetmatchesTransaction(MatchStatusv)t=v==tstatustmatchesTransaction(MatchRealv)t=v==hasRealPostingstmatchesTransaction__=FalsepostingEffectiveDate::Posting->MaybeDaypostingEffectiveDatep=maybeNothing(Just.transactionEffectiveDate)$ptransactionptransactionEffectiveDate::Transaction->DaytransactionEffectiveDatet=caseteffectivedatetofJustd->dNothing->tdatet-- | Does the match expression match this account ?-- A matching in: clause is also considered a match.matchesAccount::Matcher->AccountName->BoolmatchesAccount(MatchNotm)a=not$matchesAccountmamatchesAccount(MatchAny)_=TruematchesAccount(MatchNone)_=FalsematchesAccount(MatchOrms)a=any(`matchesAccount`a)msmatchesAccount(MatchAndms)a=all(`matchesAccount`a)msmatchesAccount(MatchAcctr)a=regexMatchesCIramatchesAccount__=False-- | What start date does this matcher specify, if any ?-- If the matcher is an OR expression, returns the earliest of the alternatives.-- When the flag is true, look for a starting effective date instead.matcherStartDate::Bool->Matcher->MaybeDaymatcherStartDateeffective(MatchOrms)=earliestMaybeDate$map(matcherStartDateeffective)msmatcherStartDateeffective(MatchAndms)=latestMaybeDate$map(matcherStartDateeffective)msmatcherStartDateFalse(MatchDate(DateSpan(Justd)_))=JustdmatcherStartDateTrue(MatchEDate(DateSpan(Justd)_))=JustdmatcherStartDate__=Nothing-- | Does this matcher specify a start date and nothing else (that would-- filter postings prior to the date) ?-- When the flag is true, look for a starting effective date instead.matcherIsStartDateOnly::Bool->Matcher->BoolmatcherIsStartDateOnly_MatchAny=FalsematcherIsStartDateOnly_MatchNone=FalsematcherIsStartDateOnlyeffective(MatchOrms)=and$map(matcherIsStartDateOnlyeffective)msmatcherIsStartDateOnlyeffective(MatchAndms)=and$map(matcherIsStartDateOnlyeffective)msmatcherIsStartDateOnlyFalse(MatchDate(DateSpan(Just_)_))=TruematcherIsStartDateOnlyTrue(MatchEDate(DateSpan(Just_)_))=TruematcherIsStartDateOnly__=False-- | Does this matcher match everything ?matcherIsNullMatchAny=TruematcherIsNull(MatchAnd[])=TruematcherIsNull(MatchNot(MatchOr[]))=TruematcherIsNull_=False-- | What is the earliest of these dates, where Nothing is earliest ?earliestMaybeDate::[MaybeDay]->MaybeDayearliestMaybeDate=headDefNothing.sortBycompareMaybeDates-- | What is the latest of these dates, where Nothing is earliest ?latestMaybeDate::[MaybeDay]->MaybeDaylatestMaybeDate=headDefNothing.sortBy(flipcompareMaybeDates)-- | Compare two maybe dates, Nothing is earliest.compareMaybeDates::MaybeDay->MaybeDay->OrderingcompareMaybeDatesNothingNothing=EQcompareMaybeDatesNothing(Just_)=LTcompareMaybeDates(Just_)Nothing=GTcompareMaybeDates(Justa)(Justb)=compareabtests_Hledger_Data_Matching::Testtests_Hledger_Data_Matching=TestList["parseQuery"~:doletd=parsedate"2011/1/1"parseQueryd"a"`is`(MatchAcct"a",[])parseQueryd"acct:a"`is`(MatchAcct"a",[])parseQueryd"acct:a desc:b"`is`(MatchAnd[MatchAcct"a",MatchDesc"b"],[])parseQueryd"\"acct:expenses:autres d\233penses\""`is`(MatchAcct"expenses:autres d\233penses",[])parseQueryd"not:desc:'a b'"`is`(MatchNot$MatchDesc"a b",[])parseQueryd"inacct:a desc:b"`is`(MatchDesc"b",[QueryOptInAcct"a"])parseQueryd"inacct:a inacct:b"`is`(MatchAny,[QueryOptInAcct"a",QueryOptInAcct"b"])parseQueryd"status:1"`is`(MatchStatusTrue,[])parseQueryd"status:0"`is`(MatchStatusFalse,[])parseQueryd"status:"`is`(MatchStatusFalse,[])parseQueryd"real:1"`is`(MatchRealTrue,[]),"matchesAccount"~:doassertBool"positive acct match"$matchesAccount(MatchAcct"b:c")"a:bb:c:d"-- assertBool "acct should match at beginning" $ not $ matchesAccount (MatchAcct True "a:b") "c:a:b","matchesPosting"~:do-- matching posting status..assertBool"positive match on true posting status"$(MatchStatusTrue)`matchesPosting`nullposting{pstatus=True}assertBool"negative match on true posting status"$not$(MatchNot$MatchStatusTrue)`matchesPosting`nullposting{pstatus=True}assertBool"positive match on false posting status"$(MatchStatusFalse)`matchesPosting`nullposting{pstatus=False}assertBool"negative match on false posting status"$not$(MatchNot$MatchStatusFalse)`matchesPosting`nullposting{pstatus=False}assertBool"positive match on true posting status acquired from transaction"$(MatchStatusTrue)`matchesPosting`nullposting{pstatus=False,ptransaction=Justnulltransaction{tstatus=True}}assertBool"real:1 on real posting"$(MatchRealTrue)`matchesPosting`nullposting{ptype=RegularPosting}assertBool"real:1 on virtual posting fails"$not$(MatchRealTrue)`matchesPosting`nullposting{ptype=VirtualPosting}assertBool"real:1 on balanced virtual posting fails"$not$(MatchRealTrue)`matchesPosting`nullposting{ptype=BalancedVirtualPosting}]