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

@@ -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

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]