diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index ad46ac398..4adc302e9 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -35,8 +35,8 @@ module Hledger.Data.Journal ( journalFilePaths, journalPostings, -- * Standard account types - journalBalanceSheetAccountMatcher, - journalProfitAndLossAccountMatcher, + journalBalanceSheetAccountQuery, + journalProfitAndLossAccountQuery, -- * Misc groupPostings, matchpats, @@ -163,17 +163,17 @@ balanceSheetAccountRegex, profitAndLossAccountRegex :: String balanceSheetAccountRegex = "^(assets?|liabilit(y|ies)|equity)(:|$)" profitAndLossAccountRegex = "^(income|expenses?|profits?|loss(es)?)(:|$)" --- | A matcher for Asset, Liability & Equity accounts in this journal. +-- | A query for Asset, Liability & Equity accounts in this journal. -- Cf . -- This is currently hard-coded to the case-insensitive regex @^(assets?|liabilit(y|ies)|equity)(:|$)@. -journalBalanceSheetAccountMatcher :: Journal -> Matcher -journalBalanceSheetAccountMatcher _ = MatchAcct balanceSheetAccountRegex +journalBalanceSheetAccountQuery :: Journal -> Matcher +journalBalanceSheetAccountQuery _ = MatchAcct balanceSheetAccountRegex --- | A matcher for Profit & Loss accounts in this journal. +-- | A query for Profit & Loss accounts in this journal. -- Cf . -- This is currently hard-coded to the case-insensitive regex @^(income|expenses?|profits?|loss(es)?)(:|$)@. -journalProfitAndLossAccountMatcher :: Journal -> Matcher -journalProfitAndLossAccountMatcher _ = MatchAcct profitAndLossAccountRegex +journalProfitAndLossAccountQuery :: Journal -> Matcher +journalProfitAndLossAccountQuery _ = MatchAcct profitAndLossAccountRegex -- Various kinds of filtering on journals. We do it differently depending -- on the command. diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 30b9bd3d3..2e87c42d5 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -49,7 +49,7 @@ journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m} -- | Filter a journal's transactions as specified, and then process them -- to derive a ledger containing all balances, the chart of accounts, -- canonicalised commodities etc. --- Like journalToLedger but uses the new matchers. +-- Like journalToLedger but uses the new queries. journalToLedger2 :: Matcher -> Journal -> Ledger journalToLedger2 m j = nullledger{journal=j',accountnametree=t,accountmap=amap} where j' = filterJournalPostings2 m j diff --git a/hledger-lib/Hledger/Data/Query.hs b/hledger-lib/Hledger/Data/Query.hs index 3bd30c40b..285001f57 100644 --- a/hledger-lib/Hledger/Data/Query.hs +++ b/hledger-lib/Hledger/Data/Query.hs @@ -7,13 +7,13 @@ Currently used only by hledger-web. module Hledger.Data.Query ( Matcher(..), - matcherIsNull, - matcherIsStartDateOnly, - matcherStartDate, + queryIsNull, + queryIsStartDateOnly, + queryStartDate, matchesTransaction, matchesPosting, inAccount, - inAccountMatcher, + inAccountQuery, tests_Hledger_Data_Query ) where @@ -42,9 +42,8 @@ import Hledger.Data.Posting import Hledger.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. +-- | A query is a composition of search criteria, which can be used to +-- match postings, transactions, accounts and more. data Matcher = MatchAny -- ^ always match | MatchNone -- ^ never match | MatchNot Matcher -- ^ negate this match @@ -77,21 +76,21 @@ inAccount [] = Nothing inAccount (QueryOptInAcctOnly a:_) = Just (a,False) inAccount (QueryOptInAcct a:_) = Just (a,True) --- | A matcher 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. -inAccountMatcher :: [QueryOpt] -> Maybe Matcher -inAccountMatcher [] = Nothing -inAccountMatcher (QueryOptInAcctOnly a:_) = Just $ MatchAcct $ accountNameToAccountOnlyRegex a -inAccountMatcher (QueryOptInAcct a:_) = Just $ MatchAcct $ accountNameToAccountRegex a +inAccountQuery :: [QueryOpt] -> Maybe Matcher +inAccountQuery [] = Nothing +inAccountQuery (QueryOptInAcctOnly a:_) = Just $ MatchAcct $ accountNameToAccountOnlyRegex a +inAccountQuery (QueryOptInAcct a:_) = Just $ MatchAcct $ accountNameToAccountRegex a --- -- | A matcher 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. -- 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: +-- terms to a query 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 @@ -109,10 +108,10 @@ parseQuery :: Day -> String -> (Matcher,[QueryOpt]) parseQuery d s = (m,qopts) where terms = words'' prefixes s - (matchers, qopts) = partitionEithers $ map (parseMatcher d) terms - m = case matchers of [] -> MatchAny - (m':[]) -> m' - ms -> MatchAnd ms + (queries, qopts) = partitionEithers $ map (parseQueryTerm d) terms + m = case queries of [] -> MatchAny + (m':[]) -> m' + ms -> MatchAnd ms -- | 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 @@ -135,14 +134,14 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX pattern = 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 +-- parseQueryTerm :: String -> Matcher +-- parseQueryTerm s = either (const (MatchAny)) id $ runParser query () "" $ lexmatcher s -- lexmatcher :: String -> [String] -- lexmatcher s = words' s --- matcher :: GenParser String () Matcher --- matcher = undefined +-- query :: GenParser String () Matcher +-- query = undefined -- keep synced with patterns below, excluding "not" prefixes = map (++":") [ @@ -151,34 +150,34 @@ prefixes = map (++":") [ ] defaultprefix = "acct" --- | Parse a single query term as either a matcher or a query option. -parseMatcher :: Day -> String -> Either Matcher QueryOpt -parseMatcher _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s -parseMatcher _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct s -parseMatcher d ('n':'o':'t':':':s) = case parseMatcher d s of +-- | Parse a single query term as either a query or a query option. +parseQueryTerm :: Day -> String -> Either Matcher QueryOpt +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 d ('n':'o':'t':':':s) = case parseQueryTerm d s of Left m -> Left $ MatchNot m Right _ -> Left MatchAny -- not:somequeryoption will be ignored -parseMatcher _ ('d':'e':'s':'c':':':s) = Left $ MatchDesc s -parseMatcher _ ('a':'c':'c':'t':':':s) = Left $ MatchAcct s -parseMatcher d ('d':'a':'t':'e':':':s) = +parseQueryTerm _ ('d':'e':'s':'c':':':s) = Left $ MatchDesc s +parseQueryTerm _ ('a':'c':'c':'t':':':s) = Left $ MatchAcct s +parseQueryTerm d ('d':'a':'t':'e':':':s) = case parsePeriodExpr d s of Left _ -> Left MatchNone -- XXX should warn Right (_,span) -> Left $ MatchDate span -parseMatcher 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 Right (_,span) -> Left $ MatchEDate span -parseMatcher _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ MatchStatus $ parseStatus s -parseMatcher _ ('r':'e':'a':'l':':':s) = Left $ MatchReal $ parseBool s -parseMatcher _ ('e':'m':'p':'t':'y':':':s) = Left $ MatchEmpty $ parseBool s -parseMatcher _ ('d':'e':'p':'t':'h':':':s) = Left $ MatchDepth $ readDef 0 s -parseMatcher _ "" = Left $ MatchAny -parseMatcher d s = parseMatcher d $ defaultprefix++":"++s +parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ MatchStatus $ parseStatus s +parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ MatchReal $ parseBool s +parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ MatchEmpty $ parseBool s +parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ MatchDepth $ readDef 0 s +parseQueryTerm _ "" = Left $ MatchAny +parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s --- | Parse the boolean value part of a "status:" matcher, allowing "*" as +-- | Parse the boolean value part of a "status:" query, allowing "*" as -- another way to spell True, similar to the journal file format. parseStatus :: String -> Bool parseStatus s = s `elem` (truestrings ++ ["*"]) --- | Parse the boolean value part of a "status:" matcher. A true value can +-- | Parse the boolean value part of a "status:" query. A true value can -- be spelled as "1", "t" or "true". parseBool :: String -> Bool parseBool s = s `elem` truestrings @@ -186,9 +185,9 @@ parseBool s = s `elem` truestrings truestrings :: [String] truestrings = ["1","t","true"] --- -- | Convert a match expression to its inverse. --- negateMatcher :: Matcher -> Matcher --- negateMatcher = MatchNot +-- -- | Convert a query to its inverse. +-- negateQuery :: Matcher -> Matcher +-- negateQuery = MatchNot -- | Does the match expression match this posting ? matchesPosting :: Matcher -> Posting -> Bool @@ -240,33 +239,33 @@ matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms matchesAccount (MatchAcct r) a = regexMatchesCI r a matchesAccount _ _ = False --- | What start date does this matcher specify, if any ? --- If the matcher is an OR expression, returns the earliest of the alternatives. +-- | What start date does this query specify, if any ? +-- 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. -matcherStartDate :: Bool -> Matcher -> Maybe Day -matcherStartDate effective (MatchOr ms) = earliestMaybeDate $ map (matcherStartDate effective) ms -matcherStartDate effective (MatchAnd ms) = latestMaybeDate $ map (matcherStartDate effective) ms -matcherStartDate False (MatchDate (DateSpan (Just d) _)) = Just d -matcherStartDate True (MatchEDate (DateSpan (Just d) _)) = Just d -matcherStartDate _ _ = Nothing +queryStartDate :: Bool -> Matcher -> Maybe Day +queryStartDate effective (MatchOr ms) = earliestMaybeDate $ map (queryStartDate effective) ms +queryStartDate effective (MatchAnd ms) = latestMaybeDate $ map (queryStartDate effective) ms +queryStartDate False (MatchDate (DateSpan (Just d) _)) = Just d +queryStartDate True (MatchEDate (DateSpan (Just d) _)) = Just d +queryStartDate _ _ = Nothing --- | Does this matcher 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) ? -- When the flag is true, look for a starting effective date instead. -matcherIsStartDateOnly :: Bool -> Matcher -> Bool -matcherIsStartDateOnly _ MatchAny = False -matcherIsStartDateOnly _ MatchNone = False -matcherIsStartDateOnly effective (MatchOr ms) = and $ map (matcherIsStartDateOnly effective) ms -matcherIsStartDateOnly effective (MatchAnd ms) = and $ map (matcherIsStartDateOnly effective) ms -matcherIsStartDateOnly False (MatchDate (DateSpan (Just _) _)) = True -matcherIsStartDateOnly True (MatchEDate (DateSpan (Just _) _)) = True -matcherIsStartDateOnly _ _ = False +queryIsStartDateOnly :: Bool -> Matcher -> Bool +queryIsStartDateOnly _ MatchAny = False +queryIsStartDateOnly _ MatchNone = False +queryIsStartDateOnly effective (MatchOr ms) = and $ map (queryIsStartDateOnly effective) ms +queryIsStartDateOnly effective (MatchAnd ms) = and $ map (queryIsStartDateOnly effective) ms +queryIsStartDateOnly False (MatchDate (DateSpan (Just _) _)) = True +queryIsStartDateOnly True (MatchEDate (DateSpan (Just _) _)) = True +queryIsStartDateOnly _ _ = False --- | Does this matcher match everything ? -matcherIsNull MatchAny = True -matcherIsNull (MatchAnd []) = True -matcherIsNull (MatchNot (MatchOr [])) = True -matcherIsNull _ = False +-- | Does this query match everything ? +queryIsNull MatchAny = True +queryIsNull (MatchAnd []) = True +queryIsNull (MatchNot (MatchOr [])) = True +queryIsNull _ = False -- | What is the earliest of these dates, where Nothing is earliest ? earliestMaybeDate :: [Maybe Day] -> Maybe Day diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 66ca39eb2..cf556edec 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -20,7 +20,7 @@ module Hledger.Reports ( whichDateFromOpts, journalSelectingDateFromOpts, journalSelectingAmountFromOpts, - optsToFilterSpec, + filterSpecFromOpts, -- * Entries report EntriesReport, EntriesReportItem, @@ -167,8 +167,8 @@ journalSelectingAmountFromOpts opts | otherwise = id -- | Convert application options to the library's generic filter specification. -optsToFilterSpec :: ReportOpts -> Day -> FilterSpec -optsToFilterSpec opts@ReportOpts{..} d = FilterSpec { +filterSpecFromOpts :: ReportOpts -> Day -> FilterSpec +filterSpecFromOpts opts@ReportOpts{..} d = FilterSpec { datespan=dateSpanFromOpts d opts ,cleared= clearedValueFromOpts opts ,real=real_ @@ -384,7 +384,7 @@ triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0" -- | Select transactions from the whole journal for a transactions report, -- with no \"current\" account. The end result is similar to --- "postingsReport" except it uses matchers 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 -- journal view. journalTransactionsReport :: ReportOpts -> Journal -> Matcher -> TransactionsReport @@ -411,43 +411,43 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) -- most recent first. Used by eg hledger-web's account register view. -- accountTransactionsReport :: ReportOpts -> Journal -> Matcher -> Matcher -> TransactionsReport -accountTransactionsReport opts j m thisacctmatcher = (label, items) +accountTransactionsReport opts j m thisacctquery = (label, items) where -- transactions affecting this account, in date order - ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns $ + ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j -- starting balance: if we are filtering by a start date and nothing else, -- the sum of postings to this account before that date; otherwise zero. - (startbal,label) | matcherIsNull m = (nullmixedamt, balancelabel) - | matcherIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel) + (startbal,label) | queryIsNull m = (nullmixedamt, balancelabel) + | queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel) | otherwise = (nullmixedamt, totallabel) where priorps = -- ltrace "priorps" $ filter (matchesPosting (-- ltrace "priormatcher" $ - MatchAnd [thisacctmatcher, tostartdatematcher])) + MatchAnd [thisacctquery, tostartdatequery])) $ transactionsPostings ts - tostartdatematcher = MatchDate (DateSpan Nothing startdate) - startdate = matcherStartDate (effective_ opts) m - items = reverse $ accountTransactionsReportItems m (Just thisacctmatcher) startbal negate ts + tostartdatequery = MatchDate (DateSpan Nothing startdate) + startdate = queryStartDate (effective_ opts) m + items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts -- | Generate transactions report items from a list of transactions, --- using the provided query and current account matchers, starting balance, +-- using the provided query and current account queries, starting balance, -- sign-setting function and balance-summing function. accountTransactionsReportItems :: Matcher -> Maybe Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem] accountTransactionsReportItems _ _ _ _ [] = [] -accountTransactionsReportItems matcher thisacctmatcher bal signfn (t:ts) = +accountTransactionsReportItems query thisacctquery bal signfn (t:ts) = -- This is used for both accountTransactionsReport and journalTransactionsReport, -- which makes it a bit overcomplicated case i of Just i' -> i':is Nothing -> is where - tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings matcher t - (psthisacct,psotheracct) = case thisacctmatcher of Just m -> partition (matchesPosting m) psmatched - Nothing -> ([],psmatched) + tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t + (psthisacct,psotheracct) = case thisacctquery of Just m -> partition (matchesPosting m) psmatched + Nothing -> ([],psmatched) numotheraccts = length $ nub $ map paccount psotheracct amt = negate $ sum $ map pamount psthisacct - acct | isNothing thisacctmatcher = summarisePostings psmatched -- journal register + acct | isNothing thisacctquery = summarisePostings psmatched -- journal register | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct | otherwise = prefix ++ summarisePostingAccounts psotheracct where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt @@ -457,7 +457,7 @@ accountTransactionsReportItems matcher thisacctmatcher bal signfn (t:ts) = where a = signfn amt b = bal + a - is = accountTransactionsReportItems matcher thisacctmatcher bal' signfn ts + is = accountTransactionsReportItems query thisacctquery bal' signfn ts -- | Generate a short readable summary of some postings, like -- "from (negatives) to (positives)". @@ -498,10 +498,10 @@ accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filte -- | Select accounts, and get their balances at the end of the selected -- period, and misc. display information, for an accounts report. Like --- "accountsReport" but uses the new matchers. Used by eg hledger-web's +-- "accountsReport" but uses the new queries. Used by eg hledger-web's -- accounts sidebar. accountsReport2 :: ReportOpts -> Matcher -> Journal -> AccountsReport -accountsReport2 opts matcher j = accountsReport' opts j (journalToLedger2 matcher) +accountsReport2 opts query j = accountsReport' opts j (journalToLedger2 query) -- Accounts report helper. accountsReport' :: ReportOpts -> Journal -> (Journal -> Ledger) -> AccountsReport diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index 8cd9b7401..4aa9ac525 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -138,7 +138,7 @@ getRegisterR = do (a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts andsubs = if subs then " (and subaccounts)" else "" filter = if filtering then ", filtered" else "" - maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountMatcher qopts + maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountQuery qopts defaultLayout $ do setTitle "hledger-web register" addHamlet [$hamlet| @@ -163,7 +163,7 @@ getRegisterOnlyR = do defaultLayout $ do setTitle "hledger-web register only" addHamlet $ - case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m' + case inAccountQuery qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m' Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m ---------------------------------------------------------------------- @@ -237,7 +237,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) = |] where l = journalToLedger nullfilterspec j - inacctmatcher = inAccountMatcher qopts + inacctmatcher = inAccountQuery qopts allaccts = isNothing inacctmatcher items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher itemAsHtml :: ViewData -> AccountsReportItem -> HtmlUrl AppRoute @@ -850,9 +850,9 @@ data ViewData = VD { ,today :: Day -- ^ today's date (for queries containing relative dates) ,j :: Journal -- ^ the up-to-date parsed unfiltered journal ,q :: String -- ^ the current q parameter, the main query expression - ,m :: Matcher -- ^ a matcher parsed from the q parameter + ,m :: Matcher -- ^ a query parsed from the q parameter ,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter - ,am :: Matcher -- ^ a matcher parsed from the accounts sidebar query expr ("a" parameter) + ,am :: Matcher -- ^ a query parsed from the accounts sidebar query expr ("a" parameter) ,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 } diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 1c835802e..b001387f2 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -110,7 +110,7 @@ tests_Hledger_Cli = TestList let opts `gives` es = do j <- samplejournal d <- getCurrentDay - accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts d) j) `is` es + accountsReportAsText opts (accountsReport opts (filterSpecFromOpts opts d) j) `is` es in TestList [ "balance report with no args" ~: @@ -281,7 +281,7 @@ tests_Hledger_Cli = TestList let opts = defreportopts{patterns_=["expenses"]} j <- samplejournal d <- getCurrentDay - showTransactions opts (optsToFilterSpec opts d) j `is` unlines + showTransactions opts (filterSpecFromOpts opts d) j `is` unlines ["2008/06/03 * eat & shop" ," expenses:food $1" ," expenses:supplies $1" @@ -294,7 +294,7 @@ tests_Hledger_Cli = TestList let opts = defreportopts{depth_=Just 2} j <- samplejournal d <- getCurrentDay - showTransactions opts (optsToFilterSpec opts d) j `is` unlines + showTransactions opts (filterSpecFromOpts opts d) j `is` unlines ["2008/01/01 income" ," income:salary $-1" ,"" @@ -323,7 +323,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let opts = defreportopts - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -341,7 +341,7 @@ tests_Hledger_Cli = TestList do let opts = defreportopts{cleared_=True} j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" @@ -353,7 +353,7 @@ tests_Hledger_Cli = TestList do let opts = defreportopts{uncleared_=True} j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -374,13 +374,13 @@ tests_Hledger_Cli = TestList ," f" ] let opts = defreportopts - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/02/02"] + registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/02/02"] ,"register report with account pattern" ~: do j <- samplejournal let opts = defreportopts{patterns_=["cash"]} - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] @@ -388,7 +388,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let opts = defreportopts{patterns_=["cAsH"]} - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] @@ -396,7 +396,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let gives displayexpr = - (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is`) + (registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is`) where opts = defreportopts{display_=Just displayexpr} "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] @@ -409,7 +409,7 @@ tests_Hledger_Cli = TestList j <- samplejournal let periodexpr `gives` dates = do j' <- samplejournal - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j') `is` dates + registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j') `is` dates where opts = defreportopts{period_=maybePeriod date1 periodexpr} "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] @@ -418,7 +418,7 @@ tests_Hledger_Cli = TestList "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] let opts = defreportopts{period_=maybePeriod date1 "yearly"} - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ," assets:cash $-2 $-1" ," expenses:food $1 0" @@ -428,9 +428,9 @@ tests_Hledger_Cli = TestList ," liabilities:debts $1 0" ] let opts = defreportopts{period_=maybePeriod date1 "quarterly"} - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] + registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True} - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] @@ -438,7 +438,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let opts = defreportopts{depth_=Just 2} - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2008/01/01 income assets:bank $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank $1 $1" @@ -460,7 +460,7 @@ tests_Hledger_Cli = TestList j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts date1) j) `is` + accountsReportAsText opts (accountsReport opts (filterSpecFromOpts opts date1) j) `is` [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" @@ -471,7 +471,7 @@ tests_Hledger_Cli = TestList j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 4cff4216b..d2ce9fd94 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -229,7 +229,7 @@ registerFromString :: String -> IO String registerFromString s = do d <- getCurrentDay j <- readJournal' s - return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts d) j + return $ postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts d) j where opts = defreportopts{empty_=True} -- | Return a similarity measure, from 0 to 1, for two strings. diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index cf7eec332..af7cc15f5 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -117,7 +117,7 @@ balance CliOpts{reportopts_=ropts} j = do d <- getCurrentDay let lines = case formatFromOpts ropts of Left err -> [err] - Right _ -> accountsReportAsText ropts $ accountsReport ropts (optsToFilterSpec ropts d) j + Right _ -> accountsReportAsText ropts $ accountsReport ropts (filterSpecFromOpts ropts d) j putStr $ unlines lines -- | Render a balance report as plain text suitable for console output. diff --git a/hledger/Hledger/Cli/Balancesheet.hs b/hledger/Hledger/Cli/Balancesheet.hs index 0df7d19d6..656a4101e 100644 --- a/hledger/Hledger/Cli/Balancesheet.hs +++ b/hledger/Hledger/Cli/Balancesheet.hs @@ -24,7 +24,7 @@ balancesheet :: CliOpts -> Journal -> IO () balancesheet CliOpts{reportopts_=ropts} j = do let lines = case formatFromOpts ropts of Left err -> [err] - Right _ -> accountsReportAsText ropts $ accountsReport2 ropts (journalBalanceSheetAccountMatcher j) j + Right _ -> accountsReportAsText ropts $ accountsReport2 ropts (journalBalanceSheetAccountQuery j) j putStr $ unlines lines tests_Hledger_Cli_Balancesheet = TestList diff --git a/hledger/Hledger/Cli/Cashflow.hs b/hledger/Hledger/Cli/Cashflow.hs index 352eab8e1..ff01d1218 100644 --- a/hledger/Hledger/Cli/Cashflow.hs +++ b/hledger/Hledger/Cli/Cashflow.hs @@ -30,8 +30,8 @@ cashflow :: CliOpts -> Journal -> IO () cashflow CliOpts{reportopts_=ropts} j = do -- let lines = case formatFromOpts ropts of Left err, Right ... d <- getCurrentDay - let m = optsToMatcher (withoutBeginDate ropts) d - cashreport@(_,total) = accountsReport2 ropts (MatchAnd [m, journalCashAccountMatcher j]) j + let m = queryFromOpts (withoutBeginDate ropts) d + cashreport@(_,total) = accountsReport2 ropts (MatchAnd [m, journalCashAccountQuery j]) j -- operatingreport@(_,operating) = accountsReport2 ropts (MatchAnd [m, journalOperatingAccountMatcher j]) j -- investingreport@(_,investing) = accountsReport2 ropts (MatchAnd [m, journalInvestingAccountMatcher j]) j -- financingreport@(_,financing) = accountsReport2 ropts (MatchAnd [m, journalFinancingAccountMatcher j]) j diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index da4a9573a..f07025115 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -25,7 +25,7 @@ barchar = '*' histogram :: CliOpts -> Journal -> IO () histogram CliOpts{reportopts_=reportopts_} j = do d <- getCurrentDay - putStr $ showHistogram reportopts_ (optsToFilterSpec reportopts_ d) j + putStr $ showHistogram reportopts_ (filterSpecFromOpts reportopts_ d) j showHistogram :: ReportOpts -> FilterSpec -> Journal -> String showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps diff --git a/hledger/Hledger/Cli/Incomestatement.hs b/hledger/Hledger/Cli/Incomestatement.hs index a23f40fe3..bc44a5c7d 100644 --- a/hledger/Hledger/Cli/Incomestatement.hs +++ b/hledger/Hledger/Cli/Incomestatement.hs @@ -24,7 +24,7 @@ incomestatement :: CliOpts -> Journal -> IO () incomestatement CliOpts{reportopts_=ropts} j = do let lines = case formatFromOpts ropts of Left err -> [err] - Right _ -> accountsReportAsText ropts $ accountsReport2 ropts (journalProfitAndLossAccountMatcher j) j + Right _ -> accountsReportAsText ropts $ accountsReport2 ropts (journalProfitAndLossAccountQuery j) j putStr $ unlines lines tests_Hledger_Cli_Incomestatement = TestList diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index f24f3966f..a68255820 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -19,7 +19,7 @@ import Hledger.Cli.Options print' :: CliOpts -> Journal -> IO () print' CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ showTransactions ropts (optsToFilterSpec ropts d) j + putStr $ showTransactions ropts (filterSpecFromOpts ropts d) j showTransactions :: ReportOpts -> FilterSpec -> Journal -> String showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 45355ea37..538c60634 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -26,7 +26,7 @@ import Hledger.Cli.Options register :: CliOpts -> Journal -> IO () register CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ postingsReportAsText ropts $ postingsReport ropts (optsToFilterSpec ropts d) j + putStr $ postingsReportAsText ropts $ postingsReport ropts (filterSpecFromOpts ropts d) j -- | Render a register report as plain text suitable for console output. postingsReportAsText :: ReportOpts -> PostingsReport -> String diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 1527deb65..3bac82d96 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -24,7 +24,7 @@ import Hledger.Utils.UTF8IOCompat (putStr) stats :: CliOpts -> Journal -> IO () stats CliOpts{reportopts_=reportopts_} j = do d <- getCurrentDay - let filterspec = optsToFilterSpec reportopts_ d + let filterspec = filterSpecFromOpts reportopts_ d l = journalToLedger filterspec j reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec) intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan