From 92404bb847a453c3b01cf601c9328fd741145e7f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 15 Jul 2018 08:37:13 +0100 Subject: [PATCH] prices: allow filtering by query, clarify docs Query arguments are allowed, prices can be filtered by date, and postings providing transaction prices can be filtered by anything. --- hledger-lib/Hledger/Query.hs | 27 +++++++++++++++++-- hledger/Hledger/Cli/Commands/Prices.hs | 36 +++++++++++++++----------- 2 files changed, 46 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index e155b95dc..1e9d20b40 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -19,6 +19,7 @@ module Hledger.Query ( -- * accessors queryIsNull, queryIsAcct, + queryIsAmt, queryIsDepth, queryIsDate, queryIsDate2, @@ -41,6 +42,8 @@ module Hledger.Query ( matchesAccount, matchesMixedAmount, matchesAmount, + matchesCommodity, + matchesMarketPrice, words'', -- * tests tests_Hledger_Query @@ -481,6 +484,10 @@ queryIsAcct :: Query -> Bool queryIsAcct (Acct _) = True queryIsAcct _ = False +queryIsAmt :: Query -> Bool +queryIsAmt (Amt _ _) = True +queryIsAmt _ = False + queryIsSym :: Query -> Bool queryIsSym (Sym _) = True queryIsSym _ = False @@ -635,6 +642,10 @@ matchesMixedAmount :: Query -> MixedAmount -> Bool matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as +matchesCommodity :: Query -> CommoditySymbol -> Bool +matchesCommodity (Sym r) s = regexMatchesCI ("^" ++ r ++ "$") (T.unpack s) +matchesCommodity _ _ = True + -- | Does the match expression match this (simple) amount ? matchesAmount :: Query -> Amount -> Bool matchesAmount (Not q) a = not $ q `matchesAmount` a @@ -644,7 +655,7 @@ matchesAmount (Or qs) a = any (`matchesAmount` a) qs matchesAmount (And qs) a = all (`matchesAmount` a) qs -- matchesAmount (Amt ord n) a = compareAmount ord n a -matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ T.unpack $ acommodity a +matchesAmount (Sym r) a = matchesCommodity (Sym r) (acommodity a) -- matchesAmount _ _ = True @@ -688,7 +699,7 @@ matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a matchesPosting (Empty _) _ = True -matchesPosting (Sym r) Posting{pamount=Mixed as} = any (regexMatchesCI $ "^" ++ r ++ "$") $ map (T.unpack . acommodity) as +matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Tag n v) p = case (n, v) of ("payee", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionPayee) $ ptransaction p ("note", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionNote) $ ptransaction p @@ -771,6 +782,18 @@ matchesTags namepat valuepat = not . null . filter (match namepat valuepat) match npat Nothing (n,_) = regexMatchesCI npat (T.unpack n) -- XXX match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v) +-- | Does the query match this market price ? +matchesMarketPrice :: Query -> MarketPrice -> Bool +matchesMarketPrice (None) _ = False +matchesMarketPrice (Not q) p = not $ matchesMarketPrice q p +matchesMarketPrice (Or qs) p = any (`matchesMarketPrice` p) qs +matchesMarketPrice (And qs) p = all (`matchesMarketPrice` p) qs +matchesMarketPrice q@(Amt _ _) p = matchesAmount q (mpamount p) +matchesMarketPrice q@(Sym _) p = matchesCommodity q (mpcommodity p) +matchesMarketPrice (Date span) p = spanContainsDate span (mpdate p) +matchesMarketPrice _ _ = True + + -- tests tests_Hledger_Query :: Test diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index e7a28ba5e..9054d72a7 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -17,28 +17,34 @@ import System.Console.CmdArgs.Explicit pricesmode = hledgerCommandMode [here| prices -Print all market prices from the journal. +Print market price directives from the journal. +With --costs, also print synthetic market prices based on transaction prices. +With --inverted-costs, also print inverse prices based on transaction prices. +Prices (and postings providing prices) can be filtered by a query. |] [flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings" ,flagNone ["inverted-costs"] (setboolopt "inverted-costs") "print transaction inverted prices from postings also"] [generalflagsgroup1] [] - ([], Nothing) + ([], Just $ argsFlag "[QUERY]") +-- XXX the original hledger-prices script always ignored assertions prices opts j = do - -- XXX the original hledger-prices script always ignored assertions - let cprices = concatMap postingCosts . allPostings $ j - icprices = concatMap postingCosts . mapAmount invertPrice . allPostings $ j - printPrices = mapM_ (putStrLn . showPrice) - ifBoolOpt opt | boolopt opt $ rawopts_ opts = id - | otherwise = const [] - allPrices = sortOn mpdate . concat $ - [ jmarketprices j - , ifBoolOpt "costs" cprices - , ifBoolOpt "inverted-costs" icprices - ] - - printPrices allPrices + d <- getCurrentDay + let + q = queryFromOpts d (reportopts_ opts) + ps = filter (matchesPosting q) $ allPostings j + mprices = jmarketprices j + cprices = concatMap postingCosts ps + icprices = concatMap postingCosts . mapAmount invertPrice $ ps + allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices + mapM_ (putStrLn . showPrice) $ + sortOn mpdate $ + filter (matchesMarketPrice q) $ + allprices + where + ifBoolOpt opt | boolopt opt $ rawopts_ opts = id + | otherwise = const [] showPrice :: MarketPrice -> String showPrice mp = unwords ["P", show $ mpdate mp, T.unpack . quoteCommoditySymbolIfNeeded $ mpcommodity mp, showAmountWithZeroCommodity $ mpamount mp]