slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rename Matcher to Query, simplify constructors

Browse Source
This commit is contained in:
Simon Michael 2012-05-16 07:12:49 +00:00
parent 0c73d91f94
commit e1b1b8bce8
7 changed files with 157 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
hledger-lib/Hledger/Data/Journal.hs
View File

@ -166,43 +166,43 @@ journalAccountNameTree = accountNameTreeFrom . journalAccountNames
-- | A query for Profit & Loss accounts in this journal. -- | A query for Profit & Loss accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>. -- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>.
journalProfitAndLossAccountQuery :: Journal -> Matcher journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j = MatchOr [journalIncomeAccountQuery j journalProfitAndLossAccountQuery j = Or [journalIncomeAccountQuery j
,journalExpenseAccountQuery j ,journalExpenseAccountQuery j
] ]
-- | A query for Income (Revenue) accounts in this journal. -- | A query for Income (Revenue) accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^(income|revenue)s?(:|$)@. -- This is currently hard-coded to the case-insensitive regex @^(income|revenue)s?(:|$)@.
journalIncomeAccountQuery :: Journal -> Matcher journalIncomeAccountQuery :: Journal -> Query
journalIncomeAccountQuery _ = MatchAcct "^(income|revenue)s?(:|$)" journalIncomeAccountQuery _ = Acct "^(income|revenue)s?(:|$)"
-- | A query for Expense accounts in this journal. -- | A query for Expense accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^expenses?(:|$)@. -- This is currently hard-coded to the case-insensitive regex @^expenses?(:|$)@.
journalExpenseAccountQuery :: Journal -> Matcher journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery _ = MatchAcct "^expenses?(:|$)" journalExpenseAccountQuery _ = Acct "^expenses?(:|$)"
-- | A query for Asset, Liability & Equity accounts in this journal. -- | A query for Asset, Liability & Equity accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>. -- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.
journalBalanceSheetAccountQuery :: Journal -> Matcher journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j = MatchOr [journalAssetAccountQuery j journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
,journalLiabilityAccountQuery j ,journalLiabilityAccountQuery j
,journalEquityAccountQuery j ,journalEquityAccountQuery j
] ]
-- | A query for Asset accounts in this journal. -- | A query for Asset accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^assets?(:|$)@. -- This is currently hard-coded to the case-insensitive regex @^assets?(:|$)@.
journalAssetAccountQuery :: Journal -> Matcher journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery _ = MatchAcct "^assets?(:|$)" journalAssetAccountQuery _ = Acct "^assets?(:|$)"
-- | A query for Liability accounts in this journal. -- | A query for Liability accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^liabilit(y|ies)(:|$)@. -- This is currently hard-coded to the case-insensitive regex @^liabilit(y|ies)(:|$)@.
journalLiabilityAccountQuery :: Journal -> Matcher journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery _ = MatchAcct "^liabilit(y|ies)(:|$)" journalLiabilityAccountQuery _ = Acct "^liabilit(y|ies)(:|$)"
-- | A query for Equity accounts in this journal. -- | A query for Equity accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^equity(:|$)@. -- This is currently hard-coded to the case-insensitive regex @^equity(:|$)@.
journalEquityAccountQuery :: Journal -> Matcher journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery _ = MatchAcct "^equity(:|$)" journalEquityAccountQuery _ = Acct "^equity(:|$)"
-- Various kinds of filtering on journals. We do it differently depending -- Various kinds of filtering on journals. We do it differently depending
-- on the command. -- on the command.
@ -212,13 +212,13 @@ journalEquityAccountQuery _ = MatchAcct "^equity(:|$)"
-- | Keep only postings matching the query expression. -- | Keep only postings matching the query expression.
-- This can leave unbalanced transactions. -- This can leave unbalanced transactions.
filterJournalPostings2 :: Matcher -> Journal -> Journal filterJournalPostings2 :: Query -> Journal -> Journal
filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts} filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}
where where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
-- | Keep only transactions matching the query expression. -- | Keep only transactions matching the query expression.
filterJournalTransactions2 :: Matcher -> Journal -> Journal filterJournalTransactions2 :: Query -> Journal -> Journal
filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts} filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts}
------------------------------------------------------------------------------- -------------------------------------------------------------------------------

2
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -50,7 +50,7 @@ journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m}
-- to derive a ledger containing all balances, the chart of accounts, -- to derive a ledger containing all balances, the chart of accounts,
-- canonicalised commodities etc. -- canonicalised commodities etc.
-- Like journalToLedger but uses the new queries. -- Like journalToLedger but uses the new queries.
journalToLedger2 :: Matcher -> Journal -> Ledger journalToLedger2 :: Query -> Journal -> Ledger
journalToLedger2 m j = nullledger{journal=j',accountnametree=t,accountmap=amap} journalToLedger2 m j = nullledger{journal=j',accountnametree=t,accountmap=amap}
where j' = filterJournalPostings2 m j where j' = filterJournalPostings2 m j
(t, amap) = journalAccountInfo j' (t, amap) = journalAccountInfo j'

220
hledger-lib/Hledger/Data/Query.hs
View File

@ -6,7 +6,7 @@ Currently used only by hledger-web.
-} -}
module Hledger.Data.Query ( module Hledger.Data.Query (
Matcher(..), Query(..),
queryIsNull, queryIsNull,
queryIsStartDateOnly, queryIsStartDateOnly,
queryStartDate, queryStartDate,
@ -44,20 +44,20 @@ import Hledger.Data.Transaction
-- | A query is a composition of search criteria, which can be used to -- | A query is a composition of search criteria, which can be used to
-- match postings, transactions, accounts and more. -- match postings, transactions, accounts and more.
data Matcher = MatchAny -- ^ always match data Query = Any -- ^ always match
| MatchNone -- ^ never match | None -- ^ never match
| MatchNot Matcher -- ^ negate this match | Not Query -- ^ negate this match
| MatchOr [Matcher] -- ^ match if any of these match | Or [Query] -- ^ match if any of these match
| MatchAnd [Matcher] -- ^ match if all of these match | And [Query] -- ^ match if all of these match
| MatchDesc String -- ^ match if description matches this regexp | Desc String -- ^ match if description matches this regexp
| MatchAcct String -- ^ match postings whose account matches this regexp | Acct String -- ^ match postings whose account matches this regexp
| MatchDate DateSpan -- ^ match if actual date in this date span | Date DateSpan -- ^ match if actual date in this date span
| MatchEDate DateSpan -- ^ match if effective date in this date span | EDate DateSpan -- ^ match if effective date in this date span
| MatchStatus Bool -- ^ match if cleared status has this value | Status Bool -- ^ match if cleared status has this value
| MatchReal Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value | Real Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value
| MatchEmpty Bool -- ^ match if "emptiness" (from the --empty command-line flag) has this value. | Empty Bool -- ^ match if "emptiness" (from the --empty command-line flag) has this value.
-- Currently this means a posting with zero amount. -- Currently this means a posting with zero amount.
| MatchDepth Int -- ^ match if account depth is less than or equal to this value | Depth Int -- ^ match if account depth is less than or equal to this value
deriving (Show, Eq) deriving (Show, Eq)
-- | A query option changes a query's/report's behaviour and output in some way. -- | A query option changes a query's/report's behaviour and output in some way.
@ -78,15 +78,15 @@ inAccount (QueryOptInAcct a:_) = Just (a,True)
-- | A query for the account(s) we are currently focussed on, if any. -- | A query for the account(s) we are currently focussed on, if any.
-- Just looks at the first query option. -- Just looks at the first query option.
inAccountQuery :: [QueryOpt] -> Maybe Matcher inAccountQuery :: [QueryOpt] -> Maybe Query
inAccountQuery [] = Nothing inAccountQuery [] = Nothing
inAccountQuery (QueryOptInAcctOnly a:_) = Just $ MatchAcct $ accountNameToAccountOnlyRegex a inAccountQuery (QueryOptInAcctOnly a:_) = Just $ Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a:_) = Just $ MatchAcct $ accountNameToAccountRegex a inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex a
-- -- | A query restricting the account(s) to be shown in the sidebar, if any. -- -- | A query restricting the account(s) to be shown in the sidebar, if any.
-- -- Just looks at the first query option. -- -- Just looks at the first query option.
-- showAccountMatcher :: [QueryOpt] -> Maybe Matcher -- showAccountMatcher :: [QueryOpt] -> Maybe Query
-- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ MatchAcct True $ accountNameToAccountRegex a -- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ Acct True $ accountNameToAccountRegex a
-- showAccountMatcher _ = Nothing -- showAccountMatcher _ = Nothing
-- | Convert a query expression containing zero or more space-separated -- | Convert a query expression containing zero or more space-separated
@ -104,14 +104,14 @@ inAccountQuery (QueryOptInAcct a:_) = Just $ MatchAcct $ accountNameToAccountReg
-- When a pattern contains spaces, it or the whole term should be enclosed in single or double quotes. -- 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. -- A reference date is required to interpret relative dates in period expressions.
-- --
parseQuery :: Day -> String -> (Matcher,[QueryOpt]) parseQuery :: Day -> String -> (Query,[QueryOpt])
parseQuery d s = (m,qopts) parseQuery d s = (m,qopts)
where where
terms = words'' prefixes s terms = words'' prefixes s
(queries, qopts) = partitionEithers $ map (parseQueryTerm d) terms (queries, qopts) = partitionEithers $ map (parseQueryTerm d) terms
m = case queries of [] -> MatchAny m = case queries of [] -> Any
(m':[]) -> m' (m':[]) -> m'
ms -> MatchAnd ms ms -> And ms
-- | Quote-and-prefix-aware version of words - don't split on spaces which -- | 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 -- are inside quotes, including quotes which may have one of the specified
@ -134,13 +134,13 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
pattern = many (noneOf " \n\r\"") pattern = many (noneOf " \n\r\"")
-- -- | Parse the query string as a boolean tree of match patterns. -- -- | Parse the query string as a boolean tree of match patterns.
-- parseQueryTerm :: String -> Matcher -- parseQueryTerm :: String -> Query
-- parseQueryTerm s = either (const (MatchAny)) id $ runParser query () "" $ lexmatcher s -- parseQueryTerm s = either (const (Any)) id $ runParser query () "" $ lexmatcher s
-- lexmatcher :: String -> [String] -- lexmatcher :: String -> [String]
-- lexmatcher s = words' s -- lexmatcher s = words' s
-- query :: GenParser String () Matcher -- query :: GenParser String () Query
-- query = undefined -- query = undefined
-- keep synced with patterns below, excluding "not" -- keep synced with patterns below, excluding "not"
@ -151,25 +151,25 @@ prefixes = map (++":") [
defaultprefix = "acct" defaultprefix = "acct"
-- | Parse a single query term as either a query or a query option. -- | Parse a single query term as either a query or a query option.
parseQueryTerm :: Day -> String -> Either Matcher QueryOpt parseQueryTerm :: Day -> String -> Either Query QueryOpt
parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s
parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct s parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct s
parseQueryTerm d ('n':'o':'t':':':s) = case parseQueryTerm d s of parseQueryTerm d ('n':'o':'t':':':s) = case parseQueryTerm d s of
Left m -> Left $ MatchNot m Left m -> Left $ Not m
Right _ -> Left MatchAny -- not:somequeryoption will be ignored Right _ -> Left Any -- not:somequeryoption will be ignored
parseQueryTerm _ ('d':'e':'s':'c':':':s) = Left $ MatchDesc s parseQueryTerm _ ('d':'e':'s':'c':':':s) = Left $ Desc s
parseQueryTerm _ ('a':'c':'c':'t':':':s) = Left $ MatchAcct s parseQueryTerm _ ('a':'c':'c':'t':':':s) = Left $ Acct s
parseQueryTerm d ('d':'a':'t':'e':':':s) = parseQueryTerm d ('d':'a':'t':'e':':':s) =
case parsePeriodExpr d s of Left _ -> Left MatchNone -- XXX should warn case parsePeriodExpr d s of Left _ -> Left None -- XXX should warn
Right (_,span) -> Left $ MatchDate span Right (_,span) -> Left $ Date span
parseQueryTerm d ('e':'d':'a':'t':'e':':':s) = parseQueryTerm d ('e':'d':'a':'t':'e':':':s) =
case parsePeriodExpr d s of Left _ -> Left MatchNone -- XXX should warn case parsePeriodExpr d s of Left _ -> Left None -- XXX should warn
Right (_,span) -> Left $ MatchEDate span Right (_,span) -> Left $ EDate span
parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ MatchStatus $ parseStatus s parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s
parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ MatchReal $ parseBool s parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s
parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ MatchEmpty $ parseBool s parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s
parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ MatchDepth $ readDef 0 s parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s
parseQueryTerm _ "" = Left $ MatchAny parseQueryTerm _ "" = Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s
-- | Parse the boolean value part of a "status:" query, allowing "*" as -- | Parse the boolean value part of a "status:" query, allowing "*" as
@ -186,43 +186,43 @@ truestrings :: [String]
truestrings = ["1","t","true"] truestrings = ["1","t","true"]
-- -- | Convert a query to its inverse. -- -- | Convert a query to its inverse.
-- negateQuery :: Matcher -> Matcher -- negateQuery :: Query -> Query
-- negateQuery = MatchNot -- negateQuery = Not
-- | Does the match expression match this posting ? -- | Does the match expression match this posting ?
matchesPosting :: Matcher -> Posting -> Bool matchesPosting :: Query -> Posting -> Bool
matchesPosting (MatchNot m) p = not $ matchesPosting m p matchesPosting (Not m) p = not $ matchesPosting m p
matchesPosting (MatchAny) _ = True matchesPosting (Any) _ = True
matchesPosting (MatchNone) _ = False matchesPosting (None) _ = False
matchesPosting (MatchOr ms) p = any (`matchesPosting` p) ms matchesPosting (Or ms) p = any (`matchesPosting` p) ms
matchesPosting (MatchAnd ms) p = all (`matchesPosting` p) ms matchesPosting (And ms) p = all (`matchesPosting` p) ms
matchesPosting (MatchDesc r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p
matchesPosting (MatchAcct r) p = regexMatchesCI r $ paccount p matchesPosting (Acct r) p = regexMatchesCI r $ paccount p
matchesPosting (MatchDate span) p = matchesPosting (Date span) p =
case d of Just d' -> spanContainsDate span d' case d of Just d' -> spanContainsDate span d'
Nothing -> False Nothing -> False
where d = maybe Nothing (Just . tdate) $ ptransaction p where d = maybe Nothing (Just . tdate) $ ptransaction p
matchesPosting (MatchEDate span) p = matchesPosting (EDate span) p =
case postingEffectiveDate p of Just d -> spanContainsDate span d case postingEffectiveDate p of Just d -> spanContainsDate span d
Nothing -> False Nothing -> False
matchesPosting (MatchStatus v) p = v == postingCleared p matchesPosting (Status v) p = v == postingCleared p
matchesPosting (MatchReal v) p = v == isReal p matchesPosting (Real v) p = v == isReal p
matchesPosting (MatchEmpty v) Posting{pamount=a} = v == isZeroMixedAmount a matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a
matchesPosting _ _ = False matchesPosting _ _ = False
-- | Does the match expression match this transaction ? -- | Does the match expression match this transaction ?
matchesTransaction :: Matcher -> Transaction -> Bool matchesTransaction :: Query -> Transaction -> Bool
matchesTransaction (MatchNot m) t = not $ matchesTransaction m t matchesTransaction (Not m) t = not $ matchesTransaction m t
matchesTransaction (MatchAny) _ = True matchesTransaction (Any) _ = True
matchesTransaction (MatchNone) _ = False matchesTransaction (None) _ = False
matchesTransaction (MatchOr ms) t = any (`matchesTransaction` t) ms matchesTransaction (Or ms) t = any (`matchesTransaction` t) ms
matchesTransaction (MatchAnd ms) t = all (`matchesTransaction` t) ms matchesTransaction (And ms) t = all (`matchesTransaction` t) ms
matchesTransaction (MatchDesc r) t = regexMatchesCI r $ tdescription t matchesTransaction (Desc r) t = regexMatchesCI r $ tdescription t
matchesTransaction m@(MatchAcct _) t = any (m `matchesPosting`) $ tpostings t matchesTransaction m@(Acct _) t = any (m `matchesPosting`) $ tpostings t
matchesTransaction (MatchDate span) t = spanContainsDate span $ tdate t matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (MatchEDate span) t = spanContainsDate span $ transactionEffectiveDate t matchesTransaction (EDate span) t = spanContainsDate span $ transactionEffectiveDate t
matchesTransaction (MatchStatus v) t = v == tstatus t matchesTransaction (Status v) t = v == tstatus t
matchesTransaction (MatchReal v) t = v == hasRealPostings t matchesTransaction (Real v) t = v == hasRealPostings t
matchesTransaction _ _ = False matchesTransaction _ _ = False
postingEffectiveDate :: Posting -> Maybe Day postingEffectiveDate :: Posting -> Maybe Day
@ -230,41 +230,41 @@ postingEffectiveDate p = maybe Nothing (Just . transactionEffectiveDate) $ ptran
-- | Does the match expression match this account ? -- | Does the match expression match this account ?
-- A matching in: clause is also considered a match. -- A matching in: clause is also considered a match.
matchesAccount :: Matcher -> AccountName -> Bool matchesAccount :: Query -> AccountName -> Bool
matchesAccount (MatchNot m) a = not $ matchesAccount m a matchesAccount (Not m) a = not $ matchesAccount m a
matchesAccount (MatchAny) _ = True matchesAccount (Any) _ = True
matchesAccount (MatchNone) _ = False matchesAccount (None) _ = False
matchesAccount (MatchOr ms) a = any (`matchesAccount` a) ms matchesAccount (Or ms) a = any (`matchesAccount` a) ms
matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms matchesAccount (And ms) a = all (`matchesAccount` a) ms
matchesAccount (MatchAcct r) a = regexMatchesCI r a matchesAccount (Acct r) a = regexMatchesCI r a
matchesAccount _ _ = False matchesAccount _ _ = False
-- | What start date does this query specify, if any ? -- | What start date does this query specify, if any ?
-- If the query is an OR expression, returns the earliest of the alternatives. -- If the query is an OR expression, returns the earliest of the alternatives.
-- When the flag is true, look for a starting effective date instead. -- When the flag is true, look for a starting effective date instead.
queryStartDate :: Bool -> Matcher -> Maybe Day queryStartDate :: Bool -> Query -> Maybe Day
queryStartDate effective (MatchOr ms) = earliestMaybeDate $ map (queryStartDate effective) ms queryStartDate effective (Or ms) = earliestMaybeDate $ map (queryStartDate effective) ms
queryStartDate effective (MatchAnd ms) = latestMaybeDate $ map (queryStartDate effective) ms queryStartDate effective (And ms) = latestMaybeDate $ map (queryStartDate effective) ms
queryStartDate False (MatchDate (DateSpan (Just d) _)) = Just d queryStartDate False (Date (DateSpan (Just d) _)) = Just d
queryStartDate True (MatchEDate (DateSpan (Just d) _)) = Just d queryStartDate True (EDate (DateSpan (Just d) _)) = Just d
queryStartDate _ _ = Nothing queryStartDate _ _ = Nothing
-- | Does this query specify a start date and nothing else (that would -- | Does this query specify a start date and nothing else (that would
-- filter postings prior to the date) ? -- filter postings prior to the date) ?
-- When the flag is true, look for a starting effective date instead. -- When the flag is true, look for a starting effective date instead.
queryIsStartDateOnly :: Bool -> Matcher -> Bool queryIsStartDateOnly :: Bool -> Query -> Bool
queryIsStartDateOnly _ MatchAny = False queryIsStartDateOnly _ Any = False
queryIsStartDateOnly _ MatchNone = False queryIsStartDateOnly _ None = False
queryIsStartDateOnly effective (MatchOr ms) = and $ map (queryIsStartDateOnly effective) ms queryIsStartDateOnly effective (Or ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly effective (MatchAnd ms) = and $ map (queryIsStartDateOnly effective) ms queryIsStartDateOnly effective (And ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly False (MatchDate (DateSpan (Just _) _)) = True queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True
queryIsStartDateOnly True (MatchEDate (DateSpan (Just _) _)) = True queryIsStartDateOnly True (EDate (DateSpan (Just _) _)) = True
queryIsStartDateOnly _ _ = False queryIsStartDateOnly _ _ = False
-- | Does this query match everything ? -- | Does this query match everything ?
queryIsNull MatchAny = True queryIsNull Any = True
queryIsNull (MatchAnd []) = True queryIsNull (And []) = True
queryIsNull (MatchNot (MatchOr [])) = True queryIsNull (Not (Or [])) = True
queryIsNull _ = False queryIsNull _ = False
-- | What is the earliest of these dates, where Nothing is earliest ? -- | What is the earliest of these dates, where Nothing is earliest ?
@ -288,39 +288,39 @@ tests_Hledger_Data_Query = TestList
"parseQuery" ~: do "parseQuery" ~: do
let d = parsedate "2011/1/1" let d = parsedate "2011/1/1"
parseQuery d "a" `is` (MatchAcct "a", []) parseQuery d "a" `is` (Acct "a", [])
parseQuery d "acct:a" `is` (MatchAcct "a", []) parseQuery d "acct:a" `is` (Acct "a", [])
parseQuery d "acct:a desc:b" `is` (MatchAnd [MatchAcct "a", MatchDesc "b"], []) parseQuery d "acct:a desc:b" `is` (And [Acct "a", Desc "b"], [])
parseQuery d "\"acct:expenses:autres d\233penses\"" `is` (MatchAcct "expenses:autres d\233penses", []) parseQuery d "\"acct:expenses:autres d\233penses\"" `is` (Acct "expenses:autres d\233penses", [])
parseQuery d "not:desc:'a b'" `is` (MatchNot $ MatchDesc "a b", []) parseQuery d "not:desc:'a b'" `is` (Not $ Desc "a b", [])
parseQuery d "inacct:a desc:b" `is` (MatchDesc "b", [QueryOptInAcct "a"]) parseQuery d "inacct:a desc:b" `is` (Desc "b", [QueryOptInAcct "a"])
parseQuery d "inacct:a inacct:b" `is` (MatchAny, [QueryOptInAcct "a", QueryOptInAcct "b"]) parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
parseQuery d "status:1" `is` (MatchStatus True, []) parseQuery d "status:1" `is` (Status True, [])
parseQuery d "status:0" `is` (MatchStatus False, []) parseQuery d "status:0" `is` (Status False, [])
parseQuery d "status:" `is` (MatchStatus False, []) parseQuery d "status:" `is` (Status False, [])
parseQuery d "real:1" `is` (MatchReal True, []) parseQuery d "real:1" `is` (Real True, [])
,"matchesAccount" ~: do ,"matchesAccount" ~: do
assertBool "positive acct match" $ matchesAccount (MatchAcct "b:c") "a:bb:c:d" assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d"
-- assertBool "acct should match at beginning" $ not $ matchesAccount (MatchAcct True "a:b") "c:a:b" -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b"
,"matchesPosting" ~: do ,"matchesPosting" ~: do
-- matching posting status.. -- matching posting status..
assertBool "positive match on true posting status" $ assertBool "positive match on true posting status" $
(MatchStatus True) `matchesPosting` nullposting{pstatus=True} (Status True) `matchesPosting` nullposting{pstatus=True}
assertBool "negative match on true posting status" $ assertBool "negative match on true posting status" $
not $ (MatchNot $ MatchStatus True) `matchesPosting` nullposting{pstatus=True} not $ (Not $ Status True) `matchesPosting` nullposting{pstatus=True}
assertBool "positive match on false posting status" $ assertBool "positive match on false posting status" $
(MatchStatus False) `matchesPosting` nullposting{pstatus=False} (Status False) `matchesPosting` nullposting{pstatus=False}
assertBool "negative match on false posting status" $ assertBool "negative match on false posting status" $
not $ (MatchNot $ MatchStatus False) `matchesPosting` nullposting{pstatus=False} not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False}
assertBool "positive match on true posting status acquired from transaction" $ assertBool "positive match on true posting status acquired from transaction" $
(MatchStatus True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}} (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}}
assertBool "real:1 on real posting" $ (MatchReal True) `matchesPosting` nullposting{ptype=RegularPosting} assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
assertBool "real:1 on virtual posting fails" $ not $ (MatchReal True) `matchesPosting` nullposting{ptype=VirtualPosting} assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
assertBool "real:1 on balanced virtual posting fails" $ not $ (MatchReal True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
,"words''" ~: do ,"words''" ~: do
assertEqual "1" ["a","b"] (words'' [] "a b") assertEqual "1" ["a","b"] (words'' [] "a b")

34
hledger-lib/Hledger/Reports.hs
View File

@ -181,17 +181,17 @@ filterSpecFromOpts opts@ReportOpts{..} d = FilterSpec {
where (apats,dpats) = parsePatternArgs patterns_ where (apats,dpats) = parsePatternArgs patterns_
-- | Convert report options to a (new) query. -- | Convert report options to a (new) query.
queryFromOpts :: ReportOpts -> Day -> Matcher queryFromOpts :: ReportOpts -> Day -> Query
queryFromOpts opts@ReportOpts{..} d = -- strace $ queryFromOpts opts@ReportOpts{..} d = -- strace $
MatchAnd $ And $
[MatchDate $ dateSpanFromOpts d opts] [Date $ dateSpanFromOpts d opts]
++ (if null apats then [] else [MatchOr $ map MatchAcct apats]) ++ (if null apats then [] else [Or $ map Acct apats])
++ (if null dpats then [] else [MatchOr $ map MatchDesc dpats]) ++ (if null dpats then [] else [Or $ map Desc dpats])
-- ++ (if null mds then [] else [MatchOr $ map MatchMetadata mds]) -- ++ (if null mds then [] else [Or $ map MatchMetadata mds])
++ (if real_ then [MatchReal True] else []) ++ (if real_ then [Real True] else [])
++ (if empty_ then [MatchEmpty True] else []) ++ (if empty_ then [Empty True] else [])
++ (maybe [] ((:[]) . MatchStatus) (clearedValueFromOpts opts)) ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
++ (maybe [] ((:[]) . MatchDepth) depth_) ++ (maybe [] ((:[]) . Depth) depth_)
where where
(apats,dpats,mds) = parsePatternArgs patterns_ (apats,dpats,mds) = parsePatternArgs patterns_
@ -403,7 +403,7 @@ triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
-- "postingsReport" except it uses queries and transaction-based report -- "postingsReport" except it uses queries and transaction-based report
-- items and the items are most recent first. Used by eg hledger-web's -- items and the items are most recent first. Used by eg hledger-web's
-- journal view. -- journal view.
journalTransactionsReport :: ReportOpts -> Journal -> Matcher -> TransactionsReport journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
where where
ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
@ -426,7 +426,7 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
-- Currently, reporting intervals are not supported, and report items are -- Currently, reporting intervals are not supported, and report items are
-- most recent first. Used by eg hledger-web's account register view. -- most recent first. Used by eg hledger-web's account register view.
-- --
accountTransactionsReport :: ReportOpts -> Journal -> Matcher -> Matcher -> TransactionsReport accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
accountTransactionsReport opts j m thisacctquery = (label, items) accountTransactionsReport opts j m thisacctquery = (label, items)
where where
-- transactions affecting this account, in date order -- transactions affecting this account, in date order
@ -441,16 +441,16 @@ accountTransactionsReport opts j m thisacctquery = (label, items)
priorps = -- ltrace "priorps" $ priorps = -- ltrace "priorps" $
filter (matchesPosting filter (matchesPosting
(-- ltrace "priormatcher" $ (-- ltrace "priormatcher" $
MatchAnd [thisacctquery, tostartdatequery])) And [thisacctquery, tostartdatequery]))
$ transactionsPostings ts $ transactionsPostings ts
tostartdatequery = MatchDate (DateSpan Nothing startdate) tostartdatequery = Date (DateSpan Nothing startdate)
startdate = queryStartDate (effective_ opts) m startdate = queryStartDate (effective_ opts) m
items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
-- | Generate transactions report items from a list of transactions, -- | Generate transactions report items from a list of transactions,
-- using the provided query and current account queries, starting balance, -- using the provided query and current account queries, starting balance,
-- sign-setting function and balance-summing function. -- sign-setting function and balance-summing function.
accountTransactionsReportItems :: Matcher -> Maybe Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem] accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
accountTransactionsReportItems _ _ _ _ [] = [] accountTransactionsReportItems _ _ _ _ [] = []
accountTransactionsReportItems query thisacctquery bal signfn (t:ts) = accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
-- This is used for both accountTransactionsReport and journalTransactionsReport, -- This is used for both accountTransactionsReport and journalTransactionsReport,
@ -490,7 +490,7 @@ summarisePostings ps =
summarisePostingAccounts :: [Posting] -> String summarisePostingAccounts :: [Posting] -> String
summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
filterTransactionPostings :: Matcher -> Transaction -> Transaction filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -516,7 +516,7 @@ accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filte
-- period, and misc. display information, for an accounts report. Like -- period, and misc. display information, for an accounts report. Like
-- "accountsReport" but uses the new queries. Used by eg hledger-web's -- "accountsReport" but uses the new queries. Used by eg hledger-web's
-- accounts sidebar. -- accounts sidebar.
accountsReport2 :: ReportOpts -> Matcher -> Journal -> AccountsReport accountsReport2 :: ReportOpts -> Query -> Journal -> AccountsReport
accountsReport2 opts query j = accountsReport' opts j (journalToLedger2 query) accountsReport2 opts query j = accountsReport' opts j (journalToLedger2 query)
-- Accounts report helper. -- Accounts report helper.

14
hledger-web/Hledger/Web/Handlers.hs
View File

@ -57,7 +57,7 @@ getJournalR = do
-- XXX like registerReportAsHtml -- XXX like registerReportAsHtml
inacct = inAccount qopts inacct = inAccount qopts
-- injournal = isNothing inacct -- injournal = isNothing inacct
filtering = m /= MatchAny filtering = m /= Any
-- showlastcolumn = if injournal && not filtering then False else True -- showlastcolumn = if injournal && not filtering then False else True
title = case inacct of title = case inacct of
Nothing -> "Journal"++filter Nothing -> "Journal"++filter
@ -97,7 +97,7 @@ getJournalEntriesR = do
vd@VD{..} <- getViewData vd@VD{..} <- getViewData
let let
sidecontent = sidebar vd sidecontent = sidebar vd
title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String
maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web journal" setTitle "hledger-web journal"
@ -132,13 +132,13 @@ getRegisterR = do
vd@VD{..} <- getViewData vd@VD{..} <- getViewData
let sidecontent = sidebar vd let sidecontent = sidebar vd
-- injournal = isNothing inacct -- injournal = isNothing inacct
filtering = m /= MatchAny filtering = m /= Any
title = "Transactions in "++a++andsubs++filter title = "Transactions in "++a++andsubs++filter
where where
(a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts (a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts
andsubs = if subs then " (and subaccounts)" else "" andsubs = if subs then " (and subaccounts)" else ""
filter = if filtering then ", filtered" else "" filter = if filtering then ", filtered" else ""
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountQuery qopts maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web register" setTitle "hledger-web register"
addHamlet [$hamlet| addHamlet [$hamlet|
@ -358,7 +358,7 @@ registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
|] |]
where where
-- inacct = inAccount qopts -- inacct = inAccount qopts
-- filtering = m /= MatchAny -- filtering = m /= Any
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [$hamlet| itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [$hamlet|
<tr.item.#{evenodd}.#{firstposting}.#{datetransition} <tr.item.#{evenodd}.#{firstposting}.#{datetransition}
@ -850,9 +850,9 @@ data ViewData = VD {
,today :: Day -- ^ today's date (for queries containing relative dates) ,today :: Day -- ^ today's date (for queries containing relative dates)
,j :: Journal -- ^ the up-to-date parsed unfiltered journal ,j :: Journal -- ^ the up-to-date parsed unfiltered journal
,q :: String -- ^ the current q parameter, the main query expression ,q :: String -- ^ the current q parameter, the main query expression
,m :: Matcher -- ^ a query parsed from the q parameter ,m :: Query -- ^ a query parsed from the q parameter
,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter ,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
,am :: Matcher -- ^ a query parsed from the accounts sidebar query expr ("a" parameter) ,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr ,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable ,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable
} }

8
hledger/Hledger/Cli/Cashflow.hs
View File

@ -31,10 +31,10 @@ cashflow CliOpts{reportopts_=ropts} j = do
-- let lines = case formatFromOpts ropts of Left err, Right ... -- let lines = case formatFromOpts ropts of Left err, Right ...
d <- getCurrentDay d <- getCurrentDay
let m = queryFromOpts (withoutBeginDate ropts) d let m = queryFromOpts (withoutBeginDate ropts) d
cashreport@(_,total) = accountsReport2 ropts (MatchAnd [m, journalCashAccountQuery j]) j cashreport@(_,total) = accountsReport2 ropts (And [m, journalCashAccountQuery j]) j
-- operatingreport@(_,operating) = accountsReport2 ropts (MatchAnd [m, journalOperatingAccountMatcher j]) j -- operatingreport@(_,operating) = accountsReport2 ropts (And [m, journalOperatingAccountMatcher j]) j
-- investingreport@(_,investing) = accountsReport2 ropts (MatchAnd [m, journalInvestingAccountMatcher j]) j -- investingreport@(_,investing) = accountsReport2 ropts (And [m, journalInvestingAccountMatcher j]) j
-- financingreport@(_,financing) = accountsReport2 ropts (MatchAnd [m, journalFinancingAccountMatcher j]) j -- financingreport@(_,financing) = accountsReport2 ropts (And [m, journalFinancingAccountMatcher j]) j
-- total = operating + investing + financing -- total = operating + investing + financing
LT.putStr $ [lt|Cashflow Statement LT.putStr $ [lt|Cashflow Statement

4
hledger/Hledger/Cli/Incomestatement.hs
View File

@ -23,8 +23,8 @@ incomestatement :: CliOpts -> Journal -> IO ()
incomestatement CliOpts{reportopts_=ropts} j = do incomestatement CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay d <- getCurrentDay
let m = queryFromOpts ropts d let m = queryFromOpts ropts d
incomereport@(_,income) = accountsReport2 ropts (MatchAnd [m, journalIncomeAccountQuery j]) j incomereport@(_,income) = accountsReport2 ropts (And [m, journalIncomeAccountQuery j]) j
expensereport@(_,expenses) = accountsReport2 ropts (MatchAnd [m, journalExpenseAccountQuery j]) j expensereport@(_,expenses) = accountsReport2 ropts (And [m, journalExpenseAccountQuery j]) j
total = income + expenses total = income + expenses
LT.putStr $ [lt|Income Statement LT.putStr $ [lt|Income Statement