{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Hledger.Query (
Query(..),
QueryOpt(..),
parseQuery,
simplifyQuery,
filterQuery,
queryIsNull,
queryIsAcct,
queryIsAmt,
queryIsDepth,
queryIsDate,
queryIsDate2,
queryIsDateOrDate2,
queryIsStartDateOnly,
queryIsSym,
queryIsReal,
queryIsStatus,
queryIsEmpty,
queryStartDate,
queryEndDate,
queryDateSpan,
queryDateSpan',
queryDepth,
inAccount,
inAccountQuery,
matchesTransaction,
matchesPosting,
matchesAccount,
matchesMixedAmount,
matchesAmount,
matchesCommodity,
matchesPriceDirective,
words'',
prefixes,
tests_Query
)
where
import Data.Data
import Data.Either
import Data.List
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Data.Time.Calendar
import Safe (readDef, maximumByDef, maximumDef, minimumDef)
import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Utils hiding (words')
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount (nullamt, usd)
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Transaction
data Query = Any
| None
| Not Query
| Or [Query]
| And [Query]
| Code Regexp
| Desc Regexp
| Acct Regexp
| Date DateSpan
| Date2 DateSpan
| StatusQ Status
| Real Bool
| Amt OrdPlus Quantity
| Sym Regexp
| Empty Bool
| Depth Int
| Tag Regexp (Maybe Regexp)
deriving (Eq,Data,Typeable)
instance Show Query where
show Any = "Any"
show None = "None"
show (Not q) = "Not (" ++ show q ++ ")"
show (Or qs) = "Or (" ++ show qs ++ ")"
show (And qs) = "And (" ++ show qs ++ ")"
show (Code r) = "Code " ++ show r
show (Desc r) = "Desc " ++ show r
show (Acct r) = "Acct " ++ show r
show (Date ds) = "Date (" ++ show ds ++ ")"
show (Date2 ds) = "Date2 (" ++ show ds ++ ")"
show (StatusQ b) = "StatusQ " ++ show b
show (Real b) = "Real " ++ show b
show (Amt ord qty) = "Amt " ++ show ord ++ " " ++ show qty
show (Sym r) = "Sym " ++ show r
show (Empty b) = "Empty " ++ show b
show (Depth n) = "Depth " ++ show n
show (Tag s ms) = "Tag " ++ show s ++ " (" ++ show ms ++ ")"
data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq
deriving (Show,Eq,Data,Typeable)
data QueryOpt = QueryOptInAcctOnly AccountName
| QueryOptInAcct AccountName
deriving (Show, Eq, Data, Typeable)
parseQuery :: Day -> T.Text -> (Query,[QueryOpt])
parseQuery d s = (q, opts)
where
terms = words'' prefixes s
(pats, opts) = partitionEithers $ map (parseQueryTerm d) terms
(descpats, pats') = partition queryIsDesc pats
(acctpats, pats'') = partition queryIsAcct pats'
(statuspats, otherpats) = partition queryIsStatus pats''
q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats
words'' :: [T.Text] -> T.Text -> [T.Text]
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases
where
maybeprefixedquotedphrases :: SimpleTextParser [T.Text]
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline
prefixedQuotedPattern :: SimpleTextParser T.Text
prefixedQuotedPattern = do
not' <- fromMaybe "" `fmap` (optional $ string "not:")
let allowednexts | T.null not' = prefixes
| otherwise = prefixes ++ [""]
next <- choice' $ map string allowednexts
let prefix :: T.Text
prefix = not' <> next
p <- singleQuotedPattern <|> doubleQuotedPattern
return $ prefix <> stripquotes p
singleQuotedPattern :: SimpleTextParser T.Text
singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])) >>= return . stripquotes . T.pack
doubleQuotedPattern :: SimpleTextParser T.Text
doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])) >>= return . stripquotes . T.pack
pattern :: SimpleTextParser T.Text
pattern = fmap T.pack $ many (noneOf (" \n\r" :: [Char]))
prefixes :: [T.Text]
prefixes = map (<>":") [
"inacctonly"
,"inacct"
,"amt"
,"code"
,"desc"
,"payee"
,"note"
,"acct"
,"date"
,"date2"
,"status"
,"cur"
,"real"
,"empty"
,"depth"
,"tag"
]
defaultprefix :: T.Text
defaultprefix = "acct"
parseQueryTerm :: Day -> T.Text -> Either Query QueryOpt
parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ QueryOptInAcctOnly s
parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ QueryOptInAcct s
parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
case parseQueryTerm d s of
Left m -> Left $ Not m
Right _ -> Left Any
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left $ Code $ T.unpack s
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left $ Desc $ T.unpack s
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left $ Tag "payee" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left $ Tag "note" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left $ Acct $ T.unpack s
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
case parsePeriodExpr d s of Left e -> error' $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Left $ Date2 span
parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
case parsePeriodExpr d s of Left e -> error' $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Left $ Date span
parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
Right st -> Left $ StatusQ st
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 "empty:" -> Just s) = Left $ Empty $ parseBool s
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| n >= 0 = Left $ Depth n
| otherwise = error' "depth: should have a positive number"
where n = readDef 0 (T.unpack s)
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left $ Sym (T.unpack s)
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left $ Tag n v where (n,v) = parseTag s
parseQueryTerm _ "" = Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
parseAmountQueryTerm :: T.Text -> (OrdPlus, Quantity)
parseAmountQueryTerm s' =
case s' of
"" -> err
(T.stripPrefix "<+" -> Just s) -> (Lt, readDef err (T.unpack s))
(T.stripPrefix "<=+" -> Just s) -> (LtEq, readDef err (T.unpack s))
(T.stripPrefix ">+" -> Just s) -> (Gt, readDef err (T.unpack s))
(T.stripPrefix ">=+" -> Just s) -> (GtEq, readDef err (T.unpack s))
(T.stripPrefix "=+" -> Just s) -> (Eq, readDef err (T.unpack s))
(T.stripPrefix "+" -> Just s) -> (Eq, readDef err (T.unpack s))
(T.stripPrefix "<-" -> Just s) -> (Lt, negate $ readDef err (T.unpack s))
(T.stripPrefix "<=-" -> Just s) -> (LtEq, negate $ readDef err (T.unpack s))
(T.stripPrefix ">-" -> Just s) -> (Gt, negate $ readDef err (T.unpack s))
(T.stripPrefix ">=-" -> Just s) -> (GtEq, negate $ readDef err (T.unpack s))
(T.stripPrefix "=-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s))
(T.stripPrefix "-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s))
(T.stripPrefix "<=" -> Just s) -> let n = readDef err (T.unpack s) in
case n of
0 -> (LtEq, 0)
_ -> (AbsLtEq, n)
(T.stripPrefix "<" -> Just s) -> let n = readDef err (T.unpack s) in
case n of 0 -> (Lt, 0)
_ -> (AbsLt, n)
(T.stripPrefix ">=" -> Just s) -> let n = readDef err (T.unpack s) in
case n of 0 -> (GtEq, 0)
_ -> (AbsGtEq, n)
(T.stripPrefix ">" -> Just s) -> let n = readDef err (T.unpack s) in
case n of 0 -> (Gt, 0)
_ -> (AbsGt, n)
(T.stripPrefix "=" -> Just s) -> (AbsEq, readDef err (T.unpack s))
s -> (AbsEq, readDef err (T.unpack s))
where
err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ T.unpack s'
parseTag :: T.Text -> (Regexp, Maybe Regexp)
parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v)
| otherwise = (T.unpack s, Nothing)
where (n,v) = T.break (=='=') s
parseStatus :: T.Text -> Either String Status
parseStatus s | s `elem` ["*","1"] = Right Cleared
| s `elem` ["!"] = Right Pending
| s `elem` ["","0"] = Right Unmarked
| otherwise = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)"
parseBool :: T.Text -> Bool
parseBool s = s `elem` truestrings
truestrings :: [T.Text]
truestrings = ["1"]
simplifyQuery :: Query -> Query
simplifyQuery q =
let q' = simplify q
in if q' == q then q else simplifyQuery q'
where
simplify (And []) = Any
simplify (And [q]) = simplify q
simplify (And qs) | same qs = simplify $ head qs
| any (==None) qs = None
| all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs
| otherwise = And $ concat $ [map simplify dateqs, map simplify otherqs]
where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs
simplify (Or []) = Any
simplify (Or [q]) = simplifyQuery q
simplify (Or qs) | same qs = simplify $ head qs
| any (==Any) qs = Any
| otherwise = Or $ map simplify $ filter (/=None) qs
simplify (Date (DateSpan Nothing Nothing)) = Any
simplify (Date2 (DateSpan Nothing Nothing)) = Any
simplify q = q
same [] = True
same (a:as) = all (a==) as
filterQuery :: (Query -> Bool) -> Query -> Query
filterQuery p = simplifyQuery . filterQuery' p
filterQuery' :: (Query -> Bool) -> Query -> Query
filterQuery' p (And qs) = And $ map (filterQuery p) qs
filterQuery' p (Or qs) = Or $ map (filterQuery p) qs
filterQuery' p q = if p q then q else Any
queryIsNull :: Query -> Bool
queryIsNull Any = True
queryIsNull (And []) = True
queryIsNull (Not (Or [])) = True
queryIsNull _ = False
queryIsDepth :: Query -> Bool
queryIsDepth (Depth _) = True
queryIsDepth _ = False
queryIsDate :: Query -> Bool
queryIsDate (Date _) = True
queryIsDate _ = False
queryIsDate2 :: Query -> Bool
queryIsDate2 (Date2 _) = True
queryIsDate2 _ = False
queryIsDateOrDate2 :: Query -> Bool
queryIsDateOrDate2 (Date _) = True
queryIsDateOrDate2 (Date2 _) = True
queryIsDateOrDate2 _ = False
queryIsDesc :: Query -> Bool
queryIsDesc (Desc _) = True
queryIsDesc _ = False
queryIsAcct :: Query -> Bool
queryIsAcct (Acct _) = True
queryIsAcct _ = False
queryIsAmt :: Query -> Bool
queryIsAmt (Amt _ _) = True
queryIsAmt _ = False
queryIsSym :: Query -> Bool
queryIsSym (Sym _) = True
queryIsSym _ = False
queryIsReal :: Query -> Bool
queryIsReal (Real _) = True
queryIsReal _ = False
queryIsStatus :: Query -> Bool
queryIsStatus (StatusQ _) = True
queryIsStatus _ = False
queryIsEmpty :: Query -> Bool
queryIsEmpty (Empty _) = True
queryIsEmpty _ = False
queryIsStartDateOnly :: Bool -> Query -> Bool
queryIsStartDateOnly _ Any = False
queryIsStartDateOnly _ None = False
queryIsStartDateOnly secondary (Or ms) = and $ map (queryIsStartDateOnly secondary) ms
queryIsStartDateOnly secondary (And ms) = and $ map (queryIsStartDateOnly secondary) ms
queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True
queryIsStartDateOnly True (Date2 (DateSpan (Just _) _)) = True
queryIsStartDateOnly _ _ = False
queryStartDate :: Bool -> Query -> Maybe Day
queryStartDate secondary (Or ms) = earliestMaybeDate $ map (queryStartDate secondary) ms
queryStartDate secondary (And ms) = latestMaybeDate $ map (queryStartDate secondary) ms
queryStartDate False (Date (DateSpan (Just d) _)) = Just d
queryStartDate True (Date2 (DateSpan (Just d) _)) = Just d
queryStartDate _ _ = Nothing
queryEndDate :: Bool -> Query -> Maybe Day
queryEndDate secondary (Or ms) = latestMaybeDate' $ map (queryEndDate secondary) ms
queryEndDate secondary (And ms) = earliestMaybeDate' $ map (queryEndDate secondary) ms
queryEndDate False (Date (DateSpan _ (Just d))) = Just d
queryEndDate True (Date2 (DateSpan _ (Just d))) = Just d
queryEndDate _ _ = Nothing
queryTermDateSpan (Date span) = Just span
queryTermDateSpan _ = Nothing
queryDateSpan :: Bool -> Query -> DateSpan
queryDateSpan secondary (Or qs) = spansUnion $ map (queryDateSpan secondary) qs
queryDateSpan secondary (And qs) = spansIntersect $ map (queryDateSpan secondary) qs
queryDateSpan False (Date span) = span
queryDateSpan True (Date2 span) = span
queryDateSpan _ _ = nulldatespan
queryDateSpan' :: Query -> DateSpan
queryDateSpan' (Or qs) = spansUnion $ map queryDateSpan' qs
queryDateSpan' (And qs) = spansIntersect $ map queryDateSpan' qs
queryDateSpan' (Date span) = span
queryDateSpan' (Date2 span) = span
queryDateSpan' _ = nulldatespan
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = minimumDef Nothing
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = maximumDef Nothing
earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' = minimumDef Nothing . filter isJust
latestMaybeDate' :: [Maybe Day] -> Maybe Day
latestMaybeDate' = maximumByDef Nothing compareNothingMax
where
compareNothingMax Nothing Nothing = EQ
compareNothingMax (Just _) Nothing = LT
compareNothingMax Nothing (Just _) = GT
compareNothingMax (Just a) (Just b) = compare a b
queryDepth :: Query -> Int
queryDepth q = case queryDepth' q of [] -> 99999
ds -> minimum ds
where
queryDepth' (Depth d) = [d]
queryDepth' (Or qs) = concatMap queryDepth' qs
queryDepth' (And qs) = concatMap queryDepth' qs
queryDepth' _ = []
inAccount :: [QueryOpt] -> Maybe (AccountName,Bool)
inAccount [] = Nothing
inAccount (QueryOptInAcctOnly a:_) = Just (a,False)
inAccount (QueryOptInAcct a:_) = Just (a,True)
inAccountQuery :: [QueryOpt] -> Maybe Query
inAccountQuery [] = Nothing
inAccountQuery (QueryOptInAcctOnly a : _) = Just $ Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a : _) = Just $ Acct $ accountNameToAccountRegex a
matchesAccount :: Query -> AccountName -> Bool
matchesAccount (None) _ = False
matchesAccount (Not m) a = not $ matchesAccount m a
matchesAccount (Or ms) a = any (`matchesAccount` a) ms
matchesAccount (And ms) a = all (`matchesAccount` a) ms
matchesAccount (Acct r) a = regexMatchesCI r (T.unpack a)
matchesAccount (Depth d) a = accountNameLevel a <= d
matchesAccount (Tag _ _) _ = False
matchesAccount _ _ = True
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
matchesAmount :: Query -> Amount -> Bool
matchesAmount (Not q) a = not $ q `matchesAmount` a
matchesAmount (Any) _ = True
matchesAmount (None) _ = False
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 = matchesCommodity (Sym r) (acommodity a)
matchesAmount _ _ = True
compareAmount :: OrdPlus -> Quantity -> Amount -> Bool
compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q
LtEq -> aq <= q
Gt -> aq > q
GtEq -> aq >= q
Eq -> aq == q
AbsLt -> abs aq < abs q
AbsLtEq -> abs aq <= abs q
AbsGt -> abs aq > abs q
AbsGtEq -> abs aq >= abs q
AbsEq -> abs aq == abs q
matchesPosting :: Query -> Posting -> Bool
matchesPosting (Not q) p = not $ q `matchesPosting` p
matchesPosting (Any) _ = True
matchesPosting (None) _ = False
matchesPosting (Or qs) p = any (`matchesPosting` p) qs
matchesPosting (And qs) p = all (`matchesPosting` p) qs
matchesPosting (Code r) p = regexMatchesCI r $ maybe "" (T.unpack . tcode) $ ptransaction p
matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" (T.unpack . tdescription) $ ptransaction p
matchesPosting (Acct r) p = matchesPosting p || matchesPosting (originalPosting p)
where matchesPosting p = regexMatchesCI r $ T.unpack $ paccount p
matchesPosting (Date span) p = span `spanContainsDate` postingDate p
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
matchesPosting (StatusQ s) p = postingStatus p == s
matchesPosting (Real v) p = v == isReal p
matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
matchesPosting (Empty _) _ = True
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
(n, v) -> matchesTags n v $ postingAllTags p
matchesTransaction :: Query -> Transaction -> Bool
matchesTransaction (Not q) t = not $ q `matchesTransaction` t
matchesTransaction (Any) _ = True
matchesTransaction (None) _ = False
matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs
matchesTransaction (And qs) t = all (`matchesTransaction` t) qs
matchesTransaction (Code r) t = regexMatchesCI r $ T.unpack $ tcode t
matchesTransaction (Desc r) t = regexMatchesCI r $ T.unpack $ tdescription t
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
matchesTransaction (StatusQ s) t = tstatus t == s
matchesTransaction (Real v) t = v == hasRealPostings t
matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Empty _) _ = True
matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Tag n v) t = case (n, v) of
("payee", Just v) -> regexMatchesCI v . T.unpack . transactionPayee $ t
("note", Just v) -> regexMatchesCI v . T.unpack . transactionNote $ t
(n, v) -> matchesTags n v $ transactionAllTags t
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags namepat valuepat = not . null . filter (match namepat valuepat)
where
match npat Nothing (n,_) = regexMatchesCI npat (T.unpack n)
match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v)
matchesPriceDirective :: Query -> PriceDirective -> Bool
matchesPriceDirective (None) _ = False
matchesPriceDirective (Not q) p = not $ matchesPriceDirective q p
matchesPriceDirective (Or qs) p = any (`matchesPriceDirective` p) qs
matchesPriceDirective (And qs) p = all (`matchesPriceDirective` p) qs
matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p)
matchesPriceDirective q@(Sym _) p = matchesCommodity q (pdcommodity p)
matchesPriceDirective (Date span) p = spanContainsDate span (pddate p)
matchesPriceDirective _ _ = True
tests_Query = tests "Query" [
test "simplifyQuery" $ do
(simplifyQuery $ Or [Acct "a"]) @?= (Acct "a")
(simplifyQuery $ Or [Any,None]) @?= (Any)
(simplifyQuery $ And [Any,None]) @?= (None)
(simplifyQuery $ And [Any,Any]) @?= (Any)
(simplifyQuery $ And [Acct "b",Any]) @?= (Acct "b")
(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any)
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)])
@?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01")))
(simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b")
,test "parseQuery" $ do
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= (And [Acct "expenses:autres d\233penses", Desc "b"], [])
parseQuery nulldate "inacct:a desc:\"b b\"" @?= (Desc "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
parseQuery nulldate "desc:'x x'" @?= (Desc "x x", [])
parseQuery nulldate "'a a' 'b" @?= (Or [Acct "a a",Acct "'b"], [])
parseQuery nulldate "\"" @?= (Acct "\"", [])
,test "words''" $ do
(words'' [] "a b") @?= ["a","b"]
(words'' [] "'a b'") @?= ["a b"]
(words'' [] "not:a b") @?= ["not:a","b"]
(words'' [] "not:'a b'") @?= ["not:a b"]
(words'' [] "'not:a b'") @?= ["not:a b"]
(words'' ["desc:"] "not:desc:'a b'") @?= ["not:desc:a b"]
(words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"]
(words'' prefixes "\"") @?= ["\""]
,test "filterQuery" $ do
filterQuery queryIsDepth Any @?= Any
filterQuery queryIsDepth (Depth 1) @?= Depth 1
filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared
filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any
,test "parseQueryTerm" $ do
parseQueryTerm nulldate "a" @?= (Left $ Acct "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= (Left $ Acct "expenses:autres d\233penses")
parseQueryTerm nulldate "not:desc:a b" @?= (Left $ Not $ Desc "a b")
parseQueryTerm nulldate "status:1" @?= (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:*" @?= (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:!" @?= (Left $ StatusQ Pending)
parseQueryTerm nulldate "status:0" @?= (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "status:" @?= (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "payee:x" @?= (Left $ Tag "payee" (Just "x"))
parseQueryTerm nulldate "note:x" @?= (Left $ Tag "note" (Just "x"))
parseQueryTerm nulldate "real:1" @?= (Left $ Real True)
parseQueryTerm nulldate "date:2008" @?= (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01"))
parseQueryTerm nulldate "date:from 2012/5/17" @?= (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01"))
parseQueryTerm nulldate "inacct:a" @?= (Right $ QueryOptInAcct "a")
parseQueryTerm nulldate "tag:a" @?= (Left $ Tag "a" Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= (Left $ Tag "a" (Just "some value"))
parseQueryTerm nulldate "amt:<0" @?= (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1)
,test "parseAmountQueryTerm" $ do
parseAmountQueryTerm "<0" @?= (Lt,0)
parseAmountQueryTerm ">0" @?= (Gt,0)
parseAmountQueryTerm ">10000.10" @?= (AbsGt,10000.1)
parseAmountQueryTerm "=0.23" @?= (AbsEq,0.23)
parseAmountQueryTerm "0.23" @?= (AbsEq,0.23)
parseAmountQueryTerm "<=+0.23" @?= (LtEq,0.23)
parseAmountQueryTerm "-0.23" @?= (Eq,(-0.23))
,test "queryStartDate" $ do
let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= small
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= small
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing
,test "queryEndDate" $ do
let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= small
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= big
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing
,test "matchesAccount" $ do
assertBool "" $ (Acct "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct "^a:b") `matchesAccount` "c:a:b"
assertBool "" $ Depth 2 `matchesAccount` "a"
assertBool "" $ Depth 2 `matchesAccount` "a:b"
assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c"
assertBool "" $ Date nulldatespan `matchesAccount` "a"
assertBool "" $ Date2 nulldatespan `matchesAccount` "a"
assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
,tests "matchesPosting" [
test "positive match on cleared posting status" $
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
,test "negative match on cleared posting status" $
assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
,test "positive match on unmarked posting status" $
assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
,test "negative match on unmarked posting status" $
assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
,test "positive match on true posting status acquired from transaction" $
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}}
,test "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
,test "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
,test "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
,test "acct:" $ assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}
,test "tag:" $ do
assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
assertBool "" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
,test "cur:" $ do
assertBool "" $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]}
assertBool "" $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]}
assertBool "" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
assertBool "" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
]
,test "matchesTransaction" $ do
assertBool "" $ Any `matchesTransaction` nulltransaction
assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
assertBool "" $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}
assertBool "" $ (Tag "payee" (Just "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag "note" (Just "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}
]