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

lib: make parseAmountQueryTerm total, improve docs/tests (#1312)

Browse Source
This commit is contained in:
Simon Michael 2020-08-04 17:39:48 -07:00
parent 08ad220448
commit 38a4704641
1 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
hledger-lib/Hledger/Query.hs
View File

@ -64,7 +64,7 @@ import Data.Monoid ((<>))
#endif #endif
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Safe (readDef, maximumByMay, maximumMay, minimumMay) import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
@ -143,8 +143,11 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo
-- showAccountMatcher _ = Nothing -- showAccountMatcher _ = Nothing
-- | Convert a query expression containing zero or more space-separated -- | Convert a query expression containing zero or more
-- terms to a query and zero or more query options. A query term is either: -- space-separated terms to a query and zero or more query options; or
-- return an error message if query parsing fails.
--
-- A query term is either:
-- --
-- 1. a search pattern, which matches on one or more fields, eg: -- 1. a search pattern, which matches on one or more fields, eg:
-- --
@ -177,7 +180,6 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo
-- (Or ([Acct "expenses:dining",Acct "out"]),[]) -- (Or ([Acct "expenses:dining",Acct "out"]),[])
-- >>> parseQuery nulldate "\"expenses:dining out\"" -- >>> parseQuery nulldate "\"expenses:dining out\""
-- (Acct "expenses:dining out",[]) -- (Acct "expenses:dining out",[])
--
parseQuery :: Day -> T.Text -> (Query,[QueryOpt]) parseQuery :: Day -> T.Text -> (Query,[QueryOpt])
parseQuery d s = (q, opts) parseQuery d s = (q, opts)
where where
@ -273,7 +275,7 @@ parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
Right st -> Left $ StatusQ st Right st -> Left $ StatusQ st
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| n >= 0 = Left $ Depth n | n >= 0 = Left $ Depth n
@ -285,41 +287,49 @@ parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left $ Tag n v where (n,v) =
parseQueryTerm _ "" = Left $ Any parseQueryTerm _ "" = Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
-- | Parse what comes after amt: . -- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an
parseAmountQueryTerm :: T.Text -> (OrdPlus, Quantity) -- OrdPlus and a Quantity, or if parsing fails, an error message. OP
parseAmountQueryTerm s' = -- can be <=, <, >=, >, or = . NUM can be a simple integer or decimal.
case s' of -- If a decimal, the decimal mark must be period, and it must have
-- feel free to do this a smarter way -- digits preceding it. Digit group marks are not allowed.
"" -> err parseAmountQueryTerm :: T.Text -> Either String (OrdPlus, Quantity)
(T.stripPrefix "<+" -> Just s) -> (Lt, readDef err (T.unpack s)) parseAmountQueryTerm amtarg =
(T.stripPrefix "<=+" -> Just s) -> (LtEq, readDef err (T.unpack s)) case amtarg of
(T.stripPrefix ">+" -> Just s) -> (Gt, readDef err (T.unpack s)) -- number has a + sign, do a signed comparison
(T.stripPrefix ">=+" -> Just s) -> (GtEq, readDef err (T.unpack s)) (parse "<=+" -> Just q) -> Right (LtEq ,q)
(T.stripPrefix "=+" -> Just s) -> (Eq, readDef err (T.unpack s)) (parse "<+" -> Just q) -> Right (Lt ,q)
(T.stripPrefix "+" -> Just s) -> (Eq, readDef err (T.unpack s)) (parse ">=+" -> Just q) -> Right (GtEq ,q)
(T.stripPrefix "<-" -> Just s) -> (Lt, negate $ readDef err (T.unpack s)) (parse ">+" -> Just q) -> Right (Gt ,q)
(T.stripPrefix "<=-" -> Just s) -> (LtEq, negate $ readDef err (T.unpack s)) (parse "=+" -> Just q) -> Right (Eq ,q)
(T.stripPrefix ">-" -> Just s) -> (Gt, negate $ readDef err (T.unpack s)) (parse "+" -> Just q) -> Right (Eq ,q)
(T.stripPrefix ">=-" -> Just s) -> (GtEq, negate $ readDef err (T.unpack s)) -- number has a - sign, do a signed comparison
(T.stripPrefix "=-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s)) (parse "<-" -> Just q) -> Right (Lt ,-q)
(T.stripPrefix "-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s)) (parse "<=-" -> Just q) -> Right (LtEq ,-q)
(T.stripPrefix "<=" -> Just s) -> let n = readDef err (T.unpack s) in (parse ">-" -> Just q) -> Right (Gt ,-q)
case n of (parse ">=-" -> Just q) -> Right (GtEq ,-q)
0 -> (LtEq, 0) (parse "=-" -> Just q) -> Right (Eq ,-q)
_ -> (AbsLtEq, n) (parse "-" -> Just q) -> Right (Eq ,-q)
(T.stripPrefix "<" -> Just s) -> let n = readDef err (T.unpack s) in -- number is unsigned and zero, do a signed comparison (more useful)
case n of 0 -> (Lt, 0) (parse "<=" -> Just 0) -> Right (LtEq ,0)
_ -> (AbsLt, n) (parse "<" -> Just 0) -> Right (Lt ,0)
(T.stripPrefix ">=" -> Just s) -> let n = readDef err (T.unpack s) in (parse ">=" -> Just 0) -> Right (GtEq ,0)
case n of 0 -> (GtEq, 0) (parse ">" -> Just 0) -> Right (Gt ,0)
_ -> (AbsGtEq, n) -- number is unsigned and non-zero, do an absolute magnitude comparison
(T.stripPrefix ">" -> Just s) -> let n = readDef err (T.unpack s) in (parse "<=" -> Just q) -> Right (AbsLtEq ,q)
case n of 0 -> (Gt, 0) (parse "<" -> Just q) -> Right (AbsLt ,q)
_ -> (AbsGt, n) (parse ">=" -> Just q) -> Right (AbsGtEq ,q)
(T.stripPrefix "=" -> Just s) -> (AbsEq, readDef err (T.unpack s)) (parse ">" -> Just q) -> Right (AbsGt ,q)
s -> (AbsEq, readDef err (T.unpack s)) (parse "=" -> Just q) -> Right (AbsEq ,q)
(parse "" -> Just q) -> Right (AbsEq ,q)
_ -> Left $
"could not parse as a comparison operator followed by an optionally-signed number: "
++ T.unpack amtarg
where where
err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ T.unpack s' -- Strip outer whitespace from the text, require and remove the
-- specified prefix, remove all whitespace from the remainder, and
-- read it as a simple integer or decimal if possible.
parse :: T.Text -> T.Text -> Maybe Quantity
parse p s = T.stripPrefix p s >>= readMay . T.unpack
parseTag :: T.Text -> (Regexp, Maybe Regexp) parseTag :: T.Text -> (Regexp, Maybe Regexp)
parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v) parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v)
@ -718,14 +728,15 @@ tests_Query = tests "Query" [
parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1) parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1)
,test "parseAmountQueryTerm" $ do ,test "parseAmountQueryTerm" $ do
parseAmountQueryTerm "<0" @?= (Lt,0) -- special case for convenience, since AbsLt 0 would be always false parseAmountQueryTerm "<0" @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false
parseAmountQueryTerm ">0" @?= (Gt,0) -- special case for convenience and consistency with above parseAmountQueryTerm ">0" @?= Right (Gt,0) -- special case for convenience and consistency with above
parseAmountQueryTerm ">10000.10" @?= (AbsGt,10000.1) parseAmountQueryTerm ">10000.10" @?= Right (AbsGt,10000.1)
parseAmountQueryTerm "=0.23" @?= (AbsEq,0.23) parseAmountQueryTerm "=0.23" @?= Right (AbsEq,0.23)
parseAmountQueryTerm "0.23" @?= (AbsEq,0.23) parseAmountQueryTerm "0.23" @?= Right (AbsEq,0.23)
parseAmountQueryTerm "<=+0.23" @?= (LtEq,0.23) parseAmountQueryTerm "<=+0.23" @?= Right (LtEq,0.23)
parseAmountQueryTerm "-0.23" @?= (Eq,(-0.23)) parseAmountQueryTerm "-0.23" @?= Right (Eq,(-0.23))
-- ,test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" @?= (AbsEq,0.23) -- XXX assertLeft $ parseAmountQueryTerm "-0,23"
assertLeft $ parseAmountQueryTerm "=.23"
,test "queryStartDate" $ do ,test "queryStartDate" $ do
let small = Just $ fromGregorian 2000 01 01 let small = Just $ fromGregorian 2000 01 01