{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Query (
Query(..),
QueryOpt(..),
payeeTag,
noteTag,
generatedTransactionTag,
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,
matchesTags,
matchesPriceDirective,
words'',
prefixes,
tests_Query
)
where
import Control.Applicative ((<|>), many, optional)
import Data.Either (partitionEithers)
import Data.List (partition)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian )
import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
import Text.Megaparsec (between, noneOf, sepBy)
import Text.Megaparsec.Char (char, string)
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,Show)
payeeTag :: Maybe String -> Either RegexError Query
payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)
noteTag :: Maybe String -> Either RegexError Query
noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)
generatedTransactionTag :: Query
generatedTransactionTag = Tag (toRegexCI' "generated-transaction") Nothing
data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq
deriving (Show,Eq)
data QueryOpt = QueryOptInAcctOnly AccountName
| QueryOptInAcct AccountName
deriving (Show, Eq)
parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])
parseQuery d s = do
let termstrs = words'' prefixes s
eterms <- sequence $ map (parseQueryTerm d) termstrs
let (pats, opts) = partitionEithers eterms
(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
Right (q, opts)
words'' :: [T.Text] -> T.Text -> [T.Text]
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases
where
maybeprefixedquotedphrases :: SimpleTextParser [T.Text]
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipNonNewlineSpaces1
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 String (Either Query QueryOpt)
parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ Right $ QueryOptInAcctOnly s
parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ Right $ QueryOptInAcct s
parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
case parseQueryTerm d s of
Right (Left m) -> Right $ Left $ Not m
Right (Right _) -> Right $ Left Any
Left err -> Left err
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s)
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s)
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s)
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s)
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s)
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Right $ Left $ Date2 span
parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
case parsePeriodExpr d s of Left e -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Right $ Left $ Date span
parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
case parseStatus s of Left e -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
Right st -> Right $ Left $ StatusQ st
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right $ Left $ Real $ parseBool s || T.null s
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right $ Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Right $ Left $ Empty $ parseBool s
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| n >= 0 = Right $ Left $ Depth n
| otherwise = Left "depth: should have a positive number"
where n = readDef 0 (T.unpack s)
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$")
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
parseQueryTerm _ "" = Right $ Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
parseAmountQueryTerm :: T.Text -> Either String (OrdPlus, Quantity)
parseAmountQueryTerm amtarg =
case amtarg of
(parse "<=+" -> Just q) -> Right (LtEq ,q)
(parse "<+" -> Just q) -> Right (Lt ,q)
(parse ">=+" -> Just q) -> Right (GtEq ,q)
(parse ">+" -> Just q) -> Right (Gt ,q)
(parse "=+" -> Just q) -> Right (Eq ,q)
(parse "+" -> Just q) -> Right (Eq ,q)
(parse "<-" -> Just q) -> Right (Lt ,-q)
(parse "<=-" -> Just q) -> Right (LtEq ,-q)
(parse ">-" -> Just q) -> Right (Gt ,-q)
(parse ">=-" -> Just q) -> Right (GtEq ,-q)
(parse "=-" -> Just q) -> Right (Eq ,-q)
(parse "-" -> Just q) -> Right (Eq ,-q)
(parse "<=" -> Just 0) -> Right (LtEq ,0)
(parse "<" -> Just 0) -> Right (Lt ,0)
(parse ">=" -> Just 0) -> Right (GtEq ,0)
(parse ">" -> Just 0) -> Right (Gt ,0)
(parse "<=" -> Just q) -> Right (AbsLtEq ,q)
(parse "<" -> Just q) -> Right (AbsLt ,q)
(parse ">=" -> Just q) -> Right (AbsGtEq ,q)
(parse ">" -> Just q) -> Right (AbsGt ,q)
(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
parse :: T.Text -> T.Text -> Maybe Quantity
parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack
parseTag :: T.Text -> Either RegexError Query
parseTag s = do
tag <- toRegexCI . T.unpack $ if T.null v then s else n
body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v)
return $ Tag tag body
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 = fromMaybe Nothing . minimumMay
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = fromMaybe Nothing . maximumMay
earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' = fromMaybe Nothing . minimumMay . filter isJust
latestMaybeDate' :: [Maybe Day] -> Maybe Day
latestMaybeDate' = fromMaybe Nothing . maximumByMay compareNothingMax
where
compareNothingMax Nothing Nothing = EQ
compareNothingMax (Just _) Nothing = LT
compareNothingMax Nothing (Just _) = GT
compareNothingMax (Just a) (Just b) = compare a b
queryDepth :: Query -> Maybe Int
queryDepth = minimumMay . queryDepth'
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 = regexMatch 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) = regexMatch r . T.unpack
matchesCommodity _ = const 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 = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p
matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p
matchesPosting (Acct r) p = matches p || matches (originalPosting p)
where matches p = regexMatch 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 (reString n, v) of
("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p
("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p
(_, 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 = regexMatch r $ T.unpack $ tcode t
matchesTransaction (Desc r) t = regexMatch 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 (reString n, v) of
("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t
("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t
(_, v) -> matchesTags n v $ transactionAllTags t
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)
where
matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch 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 $ toRegex' "a"]) @?= (Acct $ toRegex' "a")
(simplifyQuery $ Or [Any,None]) @?= (Any)
(simplifyQuery $ And [Any,None]) @?= (None)
(simplifyQuery $ And [Any,Any]) @?= (Any)
(simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b")
(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any)
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)])
@?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")
,test "parseQuery" $ do
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct $ toRegexCI' "expenses:autres d\233penses", Desc $ toRegexCI' "b"], [])
parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc $ toRegexCI' "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
parseQuery nulldate "desc:'x x'" @?= Right (Desc $ toRegexCI' "x x", [])
parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct $ toRegexCI' "a a",Acct $ toRegexCI' "'b"], [])
parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", [])
,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" @?= Right (Left $ Acct $ toRegexCI' "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct $ toRegexCI' "expenses:autres d\233penses")
parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc $ toRegexCI' "a b")
parseQueryTerm nulldate "status:1" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:*" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:!" @?= Right (Left $ StatusQ Pending)
parseQueryTerm nulldate "status:0" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "status:" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x")
parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x")
parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True)
parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01))
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01))
parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a")
parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value"))
parseQueryTerm nulldate "amt:<0" @?= Right (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1)
,test "parseAmountQueryTerm" $ do
parseAmountQueryTerm "<0" @?= Right (Lt,0)
parseAmountQueryTerm ">0" @?= Right (Gt,0)
parseAmountQueryTerm " > - 0 " @?= Right (Gt,0)
parseAmountQueryTerm ">10000.10" @?= Right (AbsGt,10000.1)
parseAmountQueryTerm "=0.23" @?= Right (AbsEq,0.23)
parseAmountQueryTerm "0.23" @?= Right (AbsEq,0.23)
parseAmountQueryTerm "<=+0.23" @?= Right (LtEq,0.23)
parseAmountQueryTerm "-0.23" @?= Right (Eq,(-0.23))
assertLeft $ parseAmountQueryTerm "-0,23"
assertLeft $ parseAmountQueryTerm "=.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 $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct $ toRegex' "^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 (toRegex' "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 $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
,test "tag:" $ do
assertBool "" $ not $ (Tag (toRegex' "a") (Just $ toRegex' "r$")) `matchesPosting` nullposting
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' "foo") (Just $ toRegex' "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' " foo ") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
,test "cur:" $ do
let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=Mixed [usd 1]}
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]}
assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
]
,test "matchesTransaction" $ do
assertBool "" $ Any `matchesTransaction` nulltransaction
assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}
assertBool "" $ (Tag (toRegex' "payee") (Just $ toRegex' "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag (toRegex' "note") (Just $ toRegex' "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag (toRegex' "postingtag") Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}
]