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

query: add >= and <= for amt queries

Browse Source
This commit is contained in:
Simon Michael 2014-06-29 11:09:13 -07:00
parent 201521dc5a
commit 04cfdac0ce
1 changed files with 35 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -274,7 +274,7 @@ tests_parseQueryTerm = [
] ]
data OrdPlus = Lt | Gt | Eq | AbsLt | AbsGt | AbsEq data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq
deriving (Show,Eq,Data,Typeable) deriving (Show,Eq,Data,Typeable)
-- can fail -- can fail
@ -284,15 +284,23 @@ parseAmountQueryTerm s' =
-- feel free to do this a smarter way -- feel free to do this a smarter way
"" -> err "" -> err
'<':'+':s -> (Lt, readDef err s) '<':'+':s -> (Lt, readDef err s)
'<':'=':'+':s -> (LtEq, readDef err s)
'>':'+':s -> (Gt, readDef err s) '>':'+':s -> (Gt, readDef err s)
'>':'=':'+':s -> (GtEq, readDef err s)
'=':'+':s -> (Eq, readDef err s) '=':'+':s -> (Eq, readDef err s)
'+':s -> (Eq, readDef err s) '+':s -> (Eq, readDef err s)
'<':'-':s -> (Lt, negate $ readDef err s) '<':'-':s -> (Lt, negate $ readDef err s)
'<':'=':'-':s -> (LtEq, negate $ readDef err s)
'>':'-':s -> (Gt, negate $ readDef err s) '>':'-':s -> (Gt, negate $ readDef err s)
'>':'=':'-':s -> (GtEq, negate $ readDef err s)
'=':'-':s -> (Eq, negate $ readDef err s) '=':'-':s -> (Eq, negate $ readDef err s)
'-':s -> (Eq, negate $ readDef err s) '-':s -> (Eq, negate $ readDef err s)
'<':'=':s -> let n = readDef err s in case n of 0 -> (LtEq, 0)
_ -> (AbsLtEq, n)
'<':s -> let n = readDef err s in case n of 0 -> (Lt, 0) '<':s -> let n = readDef err s in case n of 0 -> (Lt, 0)
_ -> (AbsLt, n) _ -> (AbsLt, n)
'>':'=':s -> let n = readDef err s in case n of 0 -> (GtEq, 0)
_ -> (AbsGtEq, n)
'>':s -> let n = readDef err s in case n of 0 -> (Gt, 0) '>':s -> let n = readDef err s in case n of 0 -> (Gt, 0)
_ -> (AbsGt, n) _ -> (AbsGt, n)
'=':s -> (AbsEq, readDef err s) '=':s -> (AbsEq, readDef err s)
@ -308,7 +316,7 @@ tests_parseAmountQueryTerm = [
">10000.10" `gives` (AbsGt,10000.1) ">10000.10" `gives` (AbsGt,10000.1)
"=0.23" `gives` (AbsEq,0.23) "=0.23" `gives` (AbsEq,0.23)
"0.23" `gives` (AbsEq,0.23) "0.23" `gives` (AbsEq,0.23)
"=+0.23" `gives` (Eq,0.23) "<=+0.23" `gives` (LtEq,0.23)
"-0.23" `gives` (Eq,(-0.23)) "-0.23" `gives` (Eq,(-0.23))
] ]
@ -567,10 +575,14 @@ matchesAmount _ _ = True
-- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? -- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
compareAmount :: OrdPlus -> Quantity -> Amount -> Bool compareAmount :: OrdPlus -> Quantity -> Amount -> Bool
compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q
LtEq -> aq <= q
Gt -> aq > q Gt -> aq > q
GtEq -> aq >= q
Eq -> aq == q Eq -> aq == q
AbsLt -> abs aq < abs q AbsLt -> abs aq < abs q
AbsLtEq -> abs aq <= abs q
AbsGt -> abs aq > abs q AbsGt -> abs aq > abs q
AbsGtEq -> abs aq >= abs q
AbsEq -> abs aq == abs q AbsEq -> abs aq == abs q
-- | Does the match expression match this posting ? -- | Does the match expression match this posting ?