basic querying by amount: "amt:<0", "amt:=100", etc.

The syntax is "amt:ON", where O is "<", "=" or ">" and N is a number.
For simple (single-commodity) amounts, this matches if the amount's quantity has the specified relationship to N.
For multi-commodity amounts, it always matches.
If parsing fails, an error is raised.
This has not been tested for floating-point precision.
This commit is contained in:
Simon Michael 2013-03-20 16:36:00 +00:00
parent 1adc583975
commit c39e424642

View File

@ -43,6 +43,7 @@ import Text.ParserCombinators.Parsec
import Hledger.Utils import Hledger.Utils
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.AccountName import Hledger.Data.AccountName
import Hledger.Data.Amount (nullamt)
import Hledger.Data.Dates import Hledger.Data.Dates
import Hledger.Data.Posting import Hledger.Data.Posting
import Hledger.Data.Transaction import Hledger.Data.Transaction
@ -61,6 +62,7 @@ data Query = Any -- ^ always match
| Date2 DateSpan -- ^ match if secondary date in this date span | Date2 DateSpan -- ^ match if secondary date in this date span
| Status Bool -- ^ match if cleared status has this value | Status Bool -- ^ match if cleared status has this value
| Real 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
| Amt Ordering Quantity -- ^ match if the amount's numeric quantity is less than/greater than/equal to some value
| Empty Bool -- ^ if true, show zero-amount postings/accounts which are usually not shown | Empty Bool -- ^ if true, show zero-amount postings/accounts which are usually not shown
-- more of a query option than a query criteria ? -- more of a query option than a query criteria ?
| Depth 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
@ -211,6 +213,7 @@ parseQueryTerm d ('e':'d':'a':'t':'e':':':s) =
Right (_,span) -> Left $ Date2 span Right (_,span) -> Left $ Date2 span
parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s
parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s
parseQueryTerm _ ('a':'m':'t':':':s) = Left $ Amt op q where (op, q) = parseAmountTest s
parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s
parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s
parseQueryTerm _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s parseQueryTerm _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s
@ -232,8 +235,30 @@ tests_parseQueryTerm = [
"inacct:a" `gives` (Right $ QueryOptInAcct "a") "inacct:a" `gives` (Right $ QueryOptInAcct "a")
"tag:a" `gives` (Left $ Tag "a" Nothing) "tag:a" `gives` (Left $ Tag "a" Nothing)
"tag:a=some value" `gives` (Left $ Tag "a" (Just "some value")) "tag:a=some value" `gives` (Left $ Tag "a" (Just "some value"))
-- "amt:<0" `gives` (Left $ Amt LT 0)
-- "amt:=.23" `gives` (Left $ Amt EQ 0.23)
-- "amt:>10000.10" `gives` (Left $ Amt GT 10000.1)
] ]
-- can fail
parseAmountTest :: String -> (Ordering, Quantity)
parseAmountTest s =
case s of
"" -> err
'<':s' -> (LT, readDef err s')
'=':s' -> (EQ, readDef err s')
'>':s' -> (GT, readDef err s')
_ -> err
where err = error' $ "could not parse as operator followed by numeric quantity: "++s
tests_parseAmountTest = [
"parseAmountTest" ~: do
let s `gives` r = parseAmountTest s `is` r
"<0" `gives` (LT,0)
"=0.23" `gives` (EQ,0.23)
">10000.10" `gives` (GT,10000.1)
]
parseTag :: String -> (String, Maybe String) parseTag :: String -> (String, Maybe String)
parseTag s | '=' `elem` s = (n, Just $ tail v) parseTag s | '=' `elem` s = (n, Just $ tail v)
| otherwise = (s, Nothing) | otherwise = (s, Nothing)
@ -475,6 +500,7 @@ matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
matchesPosting (Status v) p = v == postingCleared p matchesPosting (Status v) p = v == postingCleared p
matchesPosting (Real v) p = v == isReal p matchesPosting (Real v) p = v == isReal p
matchesPosting (Depth d) Posting{paccount=a} = Depth d `matchesAccount` a matchesPosting (Depth d) Posting{paccount=a} = Depth d `matchesAccount` a
matchesPosting (Amt op n) Posting{pamount=a} = compareMixedAmount op n a
-- matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a -- matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a
-- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty False) Posting{pamount=a} = True
-- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a
@ -483,6 +509,14 @@ matchesPosting (Tag n Nothing) p = isJust $ lookupTagByName n $ postingAllTags p
matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p
-- matchesPosting _ _ = False -- matchesPosting _ _ = False
-- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ?
-- For complext mixed amounts (with multiple commodities), this is always true.
compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool
compareMixedAmount op q (Mixed []) = compareMixedAmount op q (Mixed [nullamt])
-- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op
compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op
compareMixedAmount _ _ _ = True
tests_matchesPosting = [ tests_matchesPosting = [
"matchesPosting" ~: do "matchesPosting" ~: do
-- matching posting status.. -- matching posting status..
@ -524,6 +558,7 @@ matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
matchesTransaction (Status v) t = v == tstatus t matchesTransaction (Status v) t = v == tstatus t
matchesTransaction (Real v) t = v == hasRealPostings t matchesTransaction (Real v) t = v == hasRealPostings t
matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Empty _) _ = True matchesTransaction (Empty _) _ = True
matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
matchesTransaction (Tag n Nothing) t = isJust $ lookupTagByName n $ transactionAllTags t matchesTransaction (Tag n Nothing) t = isJust $ lookupTagByName n $ transactionAllTags t
@ -563,6 +598,7 @@ tests_Hledger_Query = TestList $
++ tests_words'' ++ tests_words''
++ tests_filterQuery ++ tests_filterQuery
++ tests_parseQueryTerm ++ tests_parseQueryTerm
++ tests_parseAmountTest
++ tests_parseQuery ++ tests_parseQuery
++ tests_matchesAccount ++ tests_matchesAccount
++ tests_matchesPosting ++ tests_matchesPosting