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

fix amt: false positives on multi-commodity amounts

Browse Source
This commit is contained in:
Simon Michael 2014-04-05 19:33:44 -07:00
parent 5cd3f6ed51
commit b689b791e3
1 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -31,6 +31,7 @@ module Hledger.Query (
matchesTransaction, matchesTransaction,
matchesPosting, matchesPosting,
matchesAccount, matchesAccount,
matchesMixedAmount,
matchesAmount, matchesAmount,
-- * tests -- * tests
tests_Hledger_Query tests_Hledger_Query
@ -541,6 +542,10 @@ tests_matchesAccount = [
assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a" assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
] ]
matchesMixedAmount :: Query -> MixedAmount -> Bool
matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
-- | Does the match expression match this (simple) amount ? -- | Does the match expression match this (simple) amount ?
matchesAmount :: Query -> Amount -> Bool matchesAmount :: Query -> Amount -> Bool
matchesAmount (Not q) a = not $ q `matchesAmount` a matchesAmount (Not q) a = not $ q `matchesAmount` a
@ -548,23 +553,23 @@ matchesAmount (Any) _ = True
matchesAmount (None) _ = False matchesAmount (None) _ = False
matchesAmount (Or qs) a = any (`matchesAmount` a) qs matchesAmount (Or qs) a = any (`matchesAmount` a) qs
matchesAmount (And qs) a = all (`matchesAmount` a) qs matchesAmount (And qs) a = all (`matchesAmount` a) qs
matchesAmount (Amt ord n) a = compareMixedAmount ord n (Mixed [a]) --
matchesAmount (Amt ord n) a = compareAmount ord n a
matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a
--
matchesAmount _ _ = True matchesAmount _ _ = True
-- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? -- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
-- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true. -- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true.
compareMixedAmount :: OrdPlus -> Quantity -> MixedAmount -> Bool
compareMixedAmount ord q (Mixed []) = compareMixedAmount ord q (Mixed [amount]) -- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
-- compareMixedAmount ord q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == ord compareAmount :: OrdPlus -> Quantity -> Amount -> Bool
compareMixedAmount ord q (Mixed [Amount{aquantity=aq}]) = case ord of compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q
Lt -> aq < q Gt -> aq > q
Gt -> aq > q Eq -> aq == q
Eq -> aq == q AbsLt -> abs aq < abs q
AbsLt -> abs aq < abs q AbsGt -> abs aq > abs q
AbsGt -> abs aq > abs q AbsEq -> abs aq == abs q
AbsEq -> abs aq == abs q
compareMixedAmount _ _ _ = True
-- | Does the match expression match this posting ? -- | Does the match expression match this posting ?
matchesPosting :: Query -> Posting -> Bool matchesPosting :: Query -> Posting -> Bool
@ -580,8 +585,9 @@ matchesPosting (Date span) p = span `spanContainsDate` postingDate p
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p 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 q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
matchesPosting (Amt ord n) Posting{pamount=a} = compareMixedAmount ord n a matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
-- matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
-- 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