{-|

A general query system for matching things (accounts, postings,
transactions..)  by various criteria, and a SimpleTextParser for query expressions.

-}

{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE ViewPatterns       #-}
{-# LANGUAGE TupleSections      #-}

module Hledger.Query (
  -- * Query and QueryOpt
  Query(..),
  QueryOpt(..),
  OrdPlus(..),
  payeeTag,
  noteTag,
  generatedTransactionTag,
  -- * parsing
  parseQuery,
  parseQueryList,
  parseQueryTerm,
  parseAccountType,
  parseDepthSpec,
  -- * modifying
  simplifyQuery,
  filterQuery,
  filterQueryOrNotQuery,
  matchesQuery,
  -- * predicates
  queryIsNull,
  queryIsDate,
  queryIsDate2,
  queryIsDateOrDate2,
  queryIsStatus,
  queryIsCode,
  queryIsDesc,
  queryIsTag,
  queryIsAcct,
  queryIsType,
  queryIsDepth,
  queryIsReal,
  queryIsAmt,
  queryIsSym,
  queryIsAmtOrSym,
  queryIsStartDateOnly,
  queryIsTransactionRelated,
  -- * accessors
  queryStartDate,
  queryEndDate,
  queryDateSpan,
  queryDateSpan',
  queryDepth,
  inAccount,
  inAccountQuery,
  -- * matching things with queries
  matchesTransaction,
  matchesTransactionExtra,
  matchesDescription,
  matchesPayeeWIP,
  matchesPosting,
  matchesPostingExtra,
  matchesAccount,
  matchesAccountExtra,
  matchesMixedAmount,
  matchesAmount,
  matchesCommodity,
  matchesTag,
  -- patternsMatchTags,
  matchesPriceDirective,
  words'',
  queryprefixes,
  -- * tests
  tests_Query
)
where

import Control.Applicative
import Data.Default (Default(..))
import Data.Either (partitionEithers)
import Data.List (partition, intercalate)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian )
import Safe (headErr, readMay, maximumByMay, maximumMay, minimumMay)
import Text.Megaparsec (between, noneOf, sepBy, try, (<?>), notFollowedBy)
import Text.Megaparsec.Char (char, string, string')


import Hledger.Utils hiding (words')
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount (amountsRaw, mixedAmount, nullamt, usd)
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Transaction
import Data.Bifunctor


-- | A query is a composition of search criteria, which can be used to
-- match postings, transactions, accounts and more.
data Query = 
  -- no-op queries
    Any                       -- ^ always match
  | None                      -- ^ never match
  -- data queries (in "standard" order, roughly as they appear in a transaction)
  | Date DateSpan             -- ^ match primary dates in this date span
  | Date2 DateSpan            -- ^ match secondary dates in this date span
  | StatusQ Status            -- ^ match this txn/posting status
  | Code Regexp               -- ^ match txn codes infix-matched by this regexp
  | Desc Regexp               -- ^ match txn descriptions infix-matched by this regexp
  | Tag Regexp (Maybe Regexp) -- ^ match if a tag's name, and optionally its value, is infix-matched by the respective regexps
  | Acct Regexp               -- ^ match account names infix-matched by this regexp
  | Type [AccountType]        -- ^ match accounts whose type is one of these (or with no types, any account)
  | Depth Int                 -- ^ match if account depth is less than or equal to this value (or, sometimes used as a display option)
  | DepthAcct Regexp Int      -- ^ match if the account matches and account depth is less than or equal to this value (usually used as a display option)
  | Real Bool                 -- ^ match postings with this "realness" value
  | Amt OrdPlus Quantity      -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value
  | Sym Regexp                -- ^ match if the commodity symbol is fully-matched by this regexp
  -- compound queries (expr:)
  | Not Query                 -- ^ negate this match
  | And [Query]               -- ^ match if all of these match
  | Or  [Query]               -- ^ match if any of these match
  -- compound queries for transactions (any:, all:)
  -- If used in a non transaction-matching context, these are equivalent to And.
  | AnyPosting  [Query]       -- ^ match if any one posting is matched by all of these
  | AllPostings [Query]       -- ^ match if all of one or more postings are matched by all of these
  deriving (Eq,Show)

instance Default Query where def = Any

-- | Construct a query for the payee: tag
payeeTag :: Maybe Text -> Either RegexError Query
payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)

-- | Construct a query for the note: tag
noteTag :: Maybe Text -> Either RegexError Query
noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)

-- | Construct a query for the generated-transaction: tag
generatedTransactionTag :: Query
generatedTransactionTag = Tag (toRegexCI' "generated-transaction") Nothing

-- | A more expressive Ord, used for amt: queries. The Abs* variants
-- compare with the absolute value of a number, ignoring sign.
data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq
 deriving (Show,Eq)

-- | A query option changes a query's/report's behaviour and output in some way.
data QueryOpt = QueryOptInAcctOnly AccountName  -- ^ show an account register focussed on this account
              | QueryOptInAcct AccountName      -- ^ as above but include sub-accounts in the account register
           -- | QueryOptCostBasis      -- ^ show amounts converted to cost where possible
           -- | QueryOptDate2  -- ^ show secondary dates instead of primary dates
    deriving (Show, Eq)

-- parsing

-- -- | A query restricting the account(s) to be shown in the sidebar, if any.
-- -- Just looks at the first query option.
-- showAccountMatcher :: [QueryOpt] -> Maybe Query
-- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ Acct True $ accountNameToAccountRegex a
-- showAccountMatcher _ = Nothing


-- | A version of parseQueryList which acts on a single Text of
-- space-separated terms.
--
-- The usual shell quoting rules are assumed. When a pattern contains
-- whitespace, it (or the whole term including prefix) should be enclosed
-- in single or double quotes.
--
-- A query term is either:
--
-- 1. a search pattern, which matches on one or more fields, eg:
--
--      acct:REGEXP     - match the account name with a regular expression
--      desc:REGEXP     - match the transaction description
--      date:PERIODEXP  - match the date with a period expression
--
--    The prefix indicates the field to match, or if there is no prefix
--    account name is assumed.
--
-- 2. a query option, which modifies the reporting behaviour in some
--    way. There is currently one of these, which may appear only once:
--
--      inacct:FULLACCTNAME
--
-- Period expressions may contain relative dates, so a reference date is
-- required to fully parse these.
--
-- >>> parseQuery nulldate "expenses:dining out"
-- Right (Or [Acct (RegexpCI "expenses:dining"),Acct (RegexpCI "out")],[])
--
-- >>> parseQuery nulldate "\"expenses:dining out\""
-- Right (Acct (RegexpCI "expenses:dining out"),[])
parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])
parseQuery d t = parseQueryList d $ words'' queryprefixes t

-- | Convert a list of space-separated queries to a single query
--
-- Multiple terms are combined as follows:
-- 1. multiple account patterns are OR'd together
-- 2. multiple description patterns are OR'd together
-- 3. multiple status patterns are OR'd together
-- 4. then all terms are AND'd together
parseQueryList :: Day -> [T.Text] -> Either String (Query, [QueryOpt])
parseQueryList d termstrs = do
  eterms <- mapM (parseQueryTerm d) termstrs
  let (pats, optss) = unzip eterms
      q = combineQueriesByType pats
  Right (q, concat optss)

combineQueriesByType :: [Query] -> Query
combineQueriesByType pats = q
  where
    (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
  
-- XXX
-- | Quote-and-prefix-aware version of words - don't split on spaces which
-- are inside quotes, including quotes which may have one of the specified
-- prefixes in front, and maybe an additional not: prefix in front of that.
words'' :: [T.Text] -> T.Text -> [T.Text]
words'' prefixes = fromparse . parsewith maybePrefixedQuotedPhrases -- XXX
   where
      maybePrefixedQuotedPhrases :: SimpleTextParser [T.Text]
      maybePrefixedQuotedPhrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, patterns] `sepBy`
          (notFollowedBy (skipNonNewlineSpaces >> char ')') >> 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 = stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char]))
      doubleQuotedPattern :: SimpleTextParser T.Text
      doubleQuotedPattern = stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char]))
      patterns :: SimpleTextParser T.Text
      patterns = T.pack <$> many (noneOf (" \n\r" :: [Char]))

-- XXX
-- keep synced with patterns below, excluding "not"
queryprefixes :: [T.Text]
queryprefixes = map (<>":") [
     "inacctonly"
    ,"inacct"
    ,"amt"
    ,"code"
    ,"desc"
    ,"payee"
    ,"note"
    ,"acct"
    ,"date"
    ,"date2"
    ,"status"
    ,"cur"
    ,"real"
    ,"empty"
    ,"depth"
    ,"tag"
    ,"type"
    ,"expr"
    ,"any"
    ,"all"
    ]

defaultprefix :: T.Text
defaultprefix = "acct"

-- -- | Parse the query string as a boolean tree of match patterns.
-- parseQueryTerm :: String -> Query
-- parseQueryTerm s = either (const (Any)) id $ runParser query () "" $ lexmatcher s

-- lexmatcher :: String -> [String]
-- lexmatcher s = words' s

-- query :: GenParser String () Query
-- query = undefined

-- | Parse a single query term as either a query or a query option,
-- or return an error message if parsing fails.
parseQueryTerm :: Day -> T.Text -> Either String (Query, [QueryOpt])
parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right (Any, [QueryOptInAcctOnly s])
parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right (Any, [QueryOptInAcct s])
parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
  case parseQueryTerm d s of
    Right (q, qopts) -> Right (Not q, qopts)
    Left err         -> Left err
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = (,[]) . Code <$> toRegexCI s
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = (,[]) . Desc <$> toRegexCI s
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = (,[]) <$> payeeTag (Just s)
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = (,[]) <$> noteTag (Just s)
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = (,[]) . Acct <$> toRegexCI 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 (_,spn) -> Right (Date2 spn, [])
parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
        case parsePeriodExpr d s of Left e         -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e
                                    Right (_,spn) -> Right (Date spn, [])
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 (StatusQ st, [])
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right (Real $ parseBool s || T.null s, [])
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = case parseAmountQueryTerm s of
  Right (ord, q) -> Right (Amt ord q, [])
  Left err       -> Left err
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) = (,[]) <$> parseDepthSpecQuery s
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = (,[]) . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = (,[]) <$> parseTag s
parseQueryTerm _ (T.stripPrefix "type:" -> Just s) = (,[]) <$> parseTypeCodes s
parseQueryTerm d (T.stripPrefix "expr:" -> Just s) = parseBooleanQuery d s
parseQueryTerm d (T.stripPrefix "any:" -> Just s) = first (AnyPosting  . (:[])) <$> parseBooleanQuery d s
parseQueryTerm d (T.stripPrefix "all:" -> Just s) = first (AllPostings . (:[])) <$> parseBooleanQuery d s
parseQueryTerm _ "" = Right (Any, [])
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s

-- | Parses a boolean query expression.
--
-- Boolean queries combine smaller queries into larger ones. The boolean operators
-- made available through this function are "NOT e", "e AND e", "e OR e", and "e e".
-- Query options defined in multiple sub-queries are simply combined by concatenating
-- all options into one list.
--
-- Boolean operators in queries take precedence over one another. For instance, the
-- prefix-operator "NOT e" is always parsed before "e AND e", "e AND e" before "e OR e",
-- and "e OR e" before "e e".
--
-- The "space" operator still works as it did before the introduction of boolean operators:
-- it combines terms according to their types, using parseQueryList.
-- Whereas the new NOT, OR, and AND operators work uniformly for all term types.
-- There is an exception: queries being OR'd may not specify a date period,
-- because that can produce multiple, possibly disjoint, report periods and result sets,
-- and we don't have report semantics worked out for it yet. (#2178)
--
-- The result of this function is either an error encountered during parsing of the
-- expression or the combined query and query options.
--
-- >>> parseBooleanQuery nulldate "expenses:dining AND out"
-- Right (And [Acct (RegexpCI "expenses:dining"),Acct (RegexpCI "out")],[])
--
-- >>> parseBooleanQuery nulldate "expenses:dining AND desc:a OR desc:b"
-- Right (Or [And [Acct (RegexpCI "expenses:dining"),Desc (RegexpCI "a")],Desc (RegexpCI "b")],[])
--
parseBooleanQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])
parseBooleanQuery d t =
  either (Left . ("failed to parse query:" <>) . customErrorBundlePretty) Right $
    parsewith spacedExprsP t

  where
    -- Our "boolean queries" are compound query expressions built with a hierarchy of combinators.
    -- At the top level we have one or more query expressions separated by space.
    -- These are combined in the default way according to their types (see combineQueriesByType).
    spacedExprsP :: SimpleTextParser (Query, [QueryOpt])
    spacedExprsP = combineWith combineQueriesByType <$> orExprsP `sepBy` skipNonNewlineSpaces1

      where
        combineWith :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
        combineWith f res =
          let (qs, qoptss) = unzip res
              qoptss'      = concat qoptss
          in case qs of
              []     -> (Any,                  qoptss')
              (q:[]) -> (simplifyQuery q,      qoptss')
              _      -> (simplifyQuery $ f qs, qoptss')

        -- Containing query expressions separated by "or".
        -- If there's more than one, make sure none contains a "date:".
        orExprsP :: SimpleTextParser (Query, [QueryOpt])
        orExprsP = do
          exprs <- andExprsP `sepBy` (try $ skipNonNewlineSpaces >> string' "or" >> skipNonNewlineSpaces1)
          if ( length exprs > 1
            && (any (/=Any) $ map (filterQuery queryIsDateOrDate2 . fst) exprs))
          then fail "sorry, using date: in OR expressions is not supported."
          else return $ combineWith Or exprs

          where
            -- Containing query expressions separated by "and".
            andExprsP :: SimpleTextParser (Query, [QueryOpt])
            andExprsP = combineWith And <$> maybeNotExprP `sepBy` (try $ skipNonNewlineSpaces >> string' "and" >> skipNonNewlineSpaces1)

              where
                -- Containing query expressions optionally preceded by "not".
                maybeNotExprP :: SimpleTextParser (Query, [QueryOpt])
                maybeNotExprP = (maybe id (\_ (q, qopts) -> (Not q, qopts)) <$>
                  optional (try $ string' "not" >> notFollowedBy (char ':') >> skipNonNewlineSpaces1)) <*> termOrParenthesisedExprP

                  where
                    -- Each of which is a parenthesised query expression or a single query term.
                    termOrParenthesisedExprP :: SimpleTextParser (Query, [QueryOpt])
                    termOrParenthesisedExprP = 
                      between (char '(' >> skipNonNewlineSpaces) (try $ skipNonNewlineSpaces >> char ')') spacedExprsP
                      <|> queryTermP

                      where
                        -- A simple query term: foo, acct:foo, desc:foo, payee:foo etc.
                        queryTermP :: SimpleTextParser (Query, [QueryOpt])
                        queryTermP = do
                          prefix <- optional queryPrefixP
                          arg <- queryArgP
                          case parseQueryTerm d (fromMaybe "" prefix <> arg) of
                            Right q  -> return q
                            Left err -> error' err

                          where
                            -- One of the query prefixes: acct:, desc:, payee: etc (plus zero or more not: prefixes).
                            queryPrefixP :: SimpleTextParser T.Text
                            queryPrefixP =
                              (string "not:" <> (fromMaybe "" <$> optional queryPrefixP))
                              <|> choice' (string <$> queryprefixes)
                              <?> "query prefix"

                            -- A query term's argument, the part after the prefix:
                            -- any text enclosed in single quotes or double quotes,
                            -- or any text up to the next space, closing parenthesis, or end of line,
                            -- if it is not one of the keywords "not", "and", "or".
                            queryArgP :: SimpleTextParser T.Text
                            queryArgP = choice'
                              [ stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])),
                                stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])),
                                T.pack <$> (notFollowedBy keywordP >> (many $ noneOf (") \n\r" :: [Char]))) ]

                              where
                                -- Any of the combinator keywords used above (not/and/or), terminated by a space.
                                keywordP :: SimpleTextParser T.Text
                                keywordP = choice' (string' <$> ["not ", "and ", "or "])

-- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an
-- OrdPlus and a Quantity, or if parsing fails, an error message. OP
-- can be <=, <, >=, >, or = . NUM can be a simple integer or decimal.
-- If a decimal, the decimal mark must be period, and it must have
-- digits preceding it. Digit group marks are not allowed.
parseAmountQueryTerm :: T.Text -> Either String (OrdPlus, Quantity)
parseAmountQueryTerm amtarg =
  case amtarg of
    -- number has a + sign, do a signed comparison
    (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)
    -- number has a - sign, do a signed comparison
    (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)
    -- number is unsigned and zero, do a signed comparison (more useful)
    (parse "<="  -> Just 0) -> Right (LtEq    ,0)
    (parse "<"   -> Just 0) -> Right (Lt      ,0)
    (parse ">="  -> Just 0) -> Right (GtEq    ,0)
    (parse ">"   -> Just 0) -> Right (Gt      ,0)
    -- number is unsigned and non-zero, do an absolute magnitude comparison
    (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 . T.unpack $
         "could not parse as a comparison operator followed by an optionally-signed number: " <> amtarg
  where
    -- 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 . T.strip) s >>= readMay . T.unpack . T.filter (/=' ')

parseTag :: T.Text -> Either RegexError Query
parseTag s = do
    tag <- toRegexCI $ if T.null v then s else n
    body <- if T.null v then pure Nothing else Just <$> toRegexCI (T.tail v)
    return $ Tag tag body
  where (n,v) = T.break (=='=') s

parseDepthSpec :: T.Text -> Either RegexError DepthSpec
parseDepthSpec s = do
    let depthString = T.unpack $ if T.null b then a else T.tail b
    depth <- case readMay depthString of
        Just d | d >= 0 -> Right d
        _ -> Left $ "depth: should be a positive number, but received " ++ depthString
    regexp <- mapM toRegexCI $ if T.null b then Nothing else Just a
    return $ case regexp of
      Nothing -> DepthSpec (Just depth) []
      Just r  -> DepthSpec Nothing [(r, depth)]
  where
    (a,b) = T.break (=='=') s

parseDepthSpecQuery :: T.Text -> Either RegexError Query
parseDepthSpecQuery s = do
    DepthSpec flat rs <- parseDepthSpec s
    let regexps = map (uncurry DepthAcct) rs
    return . And $ maybe id (\d -> (Depth d :)) flat regexps

-- | Parse one or more account type code letters to a query matching any of those types.
parseTypeCodes :: T.Text -> Either String Query
parseTypeCodes s =
  case partitionEithers $ map (parseAccountType False . T.singleton) $ T.unpack s of
    ((e:_),_) -> Left $ "could not parse " <> show e <> " as an account type code.\n" <> help
    ([],[])   -> Left help
    ([],ts)   -> Right $ Type ts
  where
    help = "type:'s argument should be one or more of " ++ accountTypeChoices False

accountTypeChoices :: Bool -> String
accountTypeChoices allowlongform = 
  intercalate ", " 
    -- keep synced with parseAccountType
    $ ["A","L","E","R","X","C","V"]
    ++ if allowlongform then ["Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] else []

-- | Case-insensitively parse one single-letter code, or one long-form word if permitted, to an account type.
-- On failure, returns the unparseable text.
parseAccountType :: Bool -> Text -> Either String AccountType
parseAccountType allowlongform s =
  case T.toLower s of
    -- keep synced with accountTypeChoices
    "a"                          -> Right Asset
    "l"                          -> Right Liability
    "e"                          -> Right Equity
    "r"                          -> Right Revenue
    "x"                          -> Right Expense
    "c"                          -> Right Cash
    "v"                          -> Right Conversion
    "asset"      | allowlongform -> Right Asset
    "liability"  | allowlongform -> Right Liability
    "equity"     | allowlongform -> Right Equity
    "revenue"    | allowlongform -> Right Revenue
    "expense"    | allowlongform -> Right Expense
    "cash"       | allowlongform -> Right Cash
    "conversion" | allowlongform -> Right Conversion
    _                            -> Left $ T.unpack s

-- | Parse the value part of a "status:" query, or return an error.
parseStatus :: T.Text -> Either String Status
parseStatus s | s `elem` ["*","1"] = Right Cleared
              | s `elem` ["","0"]  = Right Unmarked
              | s == "!"           = Right Pending
              | otherwise          = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)"

-- | Parse the boolean value part of a "status:" query. "1" means true,
-- anything else will be parsed as false without error.
parseBool :: T.Text -> Bool
parseBool s = s `elem` truestrings

truestrings :: [T.Text]
truestrings = ["1"]

-- * modifying

simplifyQuery :: Query -> Query
simplifyQuery q0 =
  let q1 = simplify q0
  in if q1 == q0 then q0 else simplifyQuery q1
  where
    simplify (And []) = Any
    simplify (And [q]) = simplify q
    simplify (And qs) | same qs = simplify $ headErr qs  -- PARTIAL headErr succeeds because pattern ensures non-null qs
                      | None `elem` qs = None
                      | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs
                      | otherwise = And $ 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 $ headErr qs  -- PARTIAL headErr succeeds because pattern ensures non-null qs
                     | Any `elem` qs = Any
                     -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs  ?
                     | 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

-- | Remove query terms (or whole sub-expressions) from this query
-- which do not match the given predicate. XXX Semantics not completely clear.
-- Also calls simplifyQuery on the result.
filterQuery :: (Query -> Bool) -> Query -> Query
filterQuery p = simplifyQuery . filterQuery' p

-- | Like filterQuery, but returns the filtered query as is, without simplifying.
-- Note this is problematic for complex boolean queries, which if split apart 
-- by filterQuery and then re-composed, may be altered. See eg #2371.
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 (Or qs) = Or $ filter (not.(==Any)) $ map (filterQuery' p) qs  -- better for some, worse for others
filterQuery' p q = if p q then q else Any

-- | Remove query terms (or whole sub-expressions) from this query
-- which match neither the given predicate nor that predicate negated 
-- (eg, if predicate is queryIsAcct, this will keep both "acct:" and "not:acct:" terms).
-- Also calls simplifyQuery on the result.
-- (Since 1.24.1, might be merged into filterQuery in future.)
-- XXX Semantics not completely clear.
filterQueryOrNotQuery :: (Query -> Bool) -> Query -> Query
filterQueryOrNotQuery p0 = simplifyQuery . filterQueryOrNotQuery' p0
  where
    filterQueryOrNotQuery' :: (Query -> Bool) -> Query -> Query
    filterQueryOrNotQuery' p (And qs)      = And $ map (filterQueryOrNotQuery p) qs
    filterQueryOrNotQuery' p (Or qs)       = Or  $ map (filterQueryOrNotQuery p) qs
    filterQueryOrNotQuery' p (Not q) | p q = Not $ filterQueryOrNotQuery p q
    filterQueryOrNotQuery' p q = if p q then q else Any

-- * predicates

-- | Does this simple query predicate match any part of this possibly compound query ?
matchesQuery :: (Query -> Bool) -> Query -> Bool
matchesQuery p (And qs) = any (matchesQuery p) qs
matchesQuery p (Or qs)  = any (matchesQuery p) qs
matchesQuery p (Not q)  = p q
matchesQuery p q        = p q

-- | Does this query match everything ?
queryIsNull :: Query -> Bool
queryIsNull Any = True
queryIsNull (And []) = True
queryIsNull (Not (Or [])) = True
queryIsNull _ = False

-- | Is this a simple query of this type (date:) ? 
-- Does not match a compound query involving and/or/not.
-- Likewise for the following functions.
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

queryIsStatus :: Query -> Bool
queryIsStatus (StatusQ _) = True
queryIsStatus _ = False

queryIsCode :: Query -> Bool
queryIsCode (Code _) = True
queryIsCode _ = False

queryIsDesc :: Query -> Bool
queryIsDesc (Desc _) = True
queryIsDesc _ = False

queryIsTag :: Query -> Bool
queryIsTag (Tag _ _) = True
queryIsTag _ = False

queryIsAcct :: Query -> Bool
queryIsAcct (Acct _) = True
queryIsAcct _ = False

queryIsType :: Query -> Bool
queryIsType (Type _) = True
queryIsType _ = False

queryIsDepth :: Query -> Bool
queryIsDepth (Depth _) = True
queryIsDepth (DepthAcct _ _) = True
queryIsDepth _ = False

queryIsReal :: Query -> Bool
queryIsReal (Real _) = True
queryIsReal _ = False

queryIsAmt :: Query -> Bool
queryIsAmt (Amt _ _) = True
queryIsAmt _         = False

queryIsSym :: Query -> Bool
queryIsSym (Sym _) = True
queryIsSym _ = False

queryIsAmtOrSym :: Query -> Bool
queryIsAmtOrSym = liftA2 (||) queryIsAmt queryIsSym

-- | Does this query specify a start date and nothing else (that would
-- filter postings prior to the date) ?
-- When the flag is true, look for a starting secondary date instead.
queryIsStartDateOnly :: Bool -> Query -> Bool
queryIsStartDateOnly _ Any = False
queryIsStartDateOnly _ None = False
queryIsStartDateOnly secondary (Or ms) = all (queryIsStartDateOnly secondary) ms
queryIsStartDateOnly secondary (And ms) = all (queryIsStartDateOnly secondary) ms
queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True
queryIsStartDateOnly True (Date2 (DateSpan (Just _) _)) = True
queryIsStartDateOnly _ _ = False

-- | Does this query involve a property of transactions (or their postings),
-- making it inapplicable to account declarations ?
queryIsTransactionRelated :: Query -> Bool
queryIsTransactionRelated = matchesQuery (
      queryIsDate
  ||| queryIsDate2
  ||| queryIsStatus
  ||| queryIsCode
  ||| queryIsDesc
  ||| queryIsReal
  ||| queryIsAmt
  ||| queryIsSym
  )

(|||) :: (a->Bool) -> (a->Bool) -> (a->Bool)
p ||| q = \v -> p v || q v

-- * accessors

-- | What start date (or secondary date) does this query specify, if any ?
-- For OR expressions, use the earliest of the dates. NOT is ignored.
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 $ fromEFDay d
queryStartDate True (Date2 (DateSpan (Just d) _)) = Just $ fromEFDay d
queryStartDate _ _ = Nothing

-- | What end date (or secondary date) does this query specify, if any ?
-- For OR expressions, use the latest of the dates. NOT is ignored.
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 $ fromEFDay d
queryEndDate True (Date2 (DateSpan _ (Just d))) = Just $ fromEFDay d
queryEndDate _ _ = Nothing

queryTermDateSpan (Date spn) = Just spn
queryTermDateSpan _ = Nothing

-- | What date span (or with a true argument, what secondary date span) does this query specify ?
-- OR clauses specifying multiple spans return their union (the span enclosing all of them).
-- AND clauses specifying multiple spans return their intersection.
-- NOT clauses are ignored.
queryDateSpan :: Bool -> Query -> DateSpan
queryDateSpan secondary (Or qs)  = spansUnion     $ map (queryDateSpan secondary) qs
queryDateSpan secondary (And qs) = spansIntersect $ map (queryDateSpan secondary) qs
queryDateSpan _     (Date spn)  = spn
queryDateSpan True (Date2 spn)  = spn
queryDateSpan _ _                = nulldatespan

-- | What date span does this query specify, treating primary and secondary dates as equivalent ?
-- OR clauses specifying multiple spans return their union (the span enclosing all of them).
-- AND clauses specifying multiple spans return their intersection.
-- NOT clauses are ignored.
queryDateSpan' :: Query -> DateSpan
queryDateSpan' (Or qs)      = spansUnion     $ map queryDateSpan' qs
queryDateSpan' (And qs)     = spansIntersect $ map queryDateSpan' qs
queryDateSpan' (Date spn)  = spn
queryDateSpan' (Date2 spn) = spn
queryDateSpan' _            = nulldatespan

-- | What is the earliest of these dates, where Nothing is earliest ?
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = fromMaybe Nothing . minimumMay

-- | What is the latest of these dates, where Nothing is earliest ?
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = fromMaybe Nothing . maximumMay

-- | What is the earliest of these dates, where Nothing is the latest ?
earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' = fromMaybe Nothing . minimumMay . filter isJust

-- | What is the latest of these dates, where Nothing is the latest ?
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

-- | The depth limit this query specifies, if it has one
queryDepth :: Query -> DepthSpec
queryDepth (Or qs)         = foldMap queryDepth qs
queryDepth (And qs)        = foldMap queryDepth qs
queryDepth (Depth d)       = DepthSpec (Just d) []
queryDepth (DepthAcct r d) = DepthSpec Nothing [(r,d)]
queryDepth _               = mempty

-- | The account we are currently focussed on, if any, and whether subaccounts are included.
-- Just looks at the first query option.
inAccount :: [QueryOpt] -> Maybe (AccountName,Bool)
inAccount [] = Nothing
inAccount (QueryOptInAcctOnly a:_) = Just (a,False)
inAccount (QueryOptInAcct a:_) = Just (a,True)

-- | A query for the account(s) we are currently focussed on, if any.
-- Just looks at the first query option.
inAccountQuery :: [QueryOpt] -> Maybe Query
inAccountQuery [] = Nothing
inAccountQuery (QueryOptInAcctOnly a : _) = Just . Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a     : _) = Just . Acct $ accountNameToAccountRegex a

-- -- | Convert a query to its inverse.
-- negateQuery :: Query -> Query
-- negateQuery =  Not

-- matching things with queries

matchesCommodity :: Query -> CommoditySymbol -> Bool
matchesCommodity (Sym r)          s = regexMatchText r s
matchesCommodity (Any)            _ = True
matchesCommodity (None)           _ = False
matchesCommodity (Or qs)          s = any (`matchesCommodity` s) qs
matchesCommodity (And qs)         s = all (`matchesCommodity` s) qs
matchesCommodity (AnyPosting qs)  s = all (`matchesCommodity` s) qs
matchesCommodity (AllPostings qs) s = all1 (`matchesCommodity` s) qs
matchesCommodity _                _ = False

-- | Does the match expression match this (simple) amount ?
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 (AnyPosting  qs) a = all (`matchesAmount` a) qs
matchesAmount (AllPostings qs) a = all1 (`matchesAmount` a) qs
matchesAmount (Amt ord n) a = compareAmount ord n a
matchesAmount (Sym r) a = matchesCommodity (Sym r) (acommodity a)
matchesAmount _ _ = True

-- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
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

matchesMixedAmount :: Query -> MixedAmount -> Bool
matchesMixedAmount q ma = case amountsRaw ma of
    [] -> q `matchesAmount` nullamt
    as -> any (q `matchesAmount`) as

-- | Does the query match this account name ?
-- A matching in: clause is also considered a match.
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 (AnyPosting  qs) a = all (`matchesAccount` a) qs
matchesAccount (AllPostings qs) a = all1 (`matchesAccount` a) qs
matchesAccount (Acct r) a = regexMatchText r a
matchesAccount (Depth d) a = accountNameLevel a <= d
matchesAccount (DepthAcct r d) a = accountNameLevel a <= d || not (regexMatchText r a)
matchesAccount (Tag _ _) _ = False
matchesAccount _ _ = True

-- | Like matchesAccount, but with optional extra matching features:
--
-- - If the account's type is provided, any type: terms in the query
--   must match it (and any negated type: terms must not match it).
--
-- - If the account's tags are provided, any tag: terms must match
--   at least one of them (and any negated tag: terms must match none).
--
matchesAccountExtra :: (AccountName -> Maybe AccountType) -> (AccountName -> [Tag]) -> Query -> AccountName -> Bool
matchesAccountExtra atypes atags (Not q  ) a = not $ matchesAccountExtra atypes atags q a
matchesAccountExtra atypes atags (Or  qs ) a = any (\q -> matchesAccountExtra atypes atags q a) qs
matchesAccountExtra atypes atags (And qs ) a = all (\q -> matchesAccountExtra atypes atags q a) qs
matchesAccountExtra atypes atags (AnyPosting  qs ) a = all (\q -> matchesAccountExtra atypes atags q a) qs
matchesAccountExtra atypes atags (AllPostings qs ) a = all1 (\q -> matchesAccountExtra atypes atags q a) qs
matchesAccountExtra atypes _     (Type ts) a = maybe False (\t -> any (t `isAccountSubtypeOf`) ts) $ atypes a
matchesAccountExtra _      atags (Tag npat vpat) a = patternsMatchTags npat vpat $ atags a
matchesAccountExtra _      _     q         a = matchesAccount q a

-- | Does the match expression match this posting ?
-- When matching account name, and the posting has been transformed
-- in some way, we will match either the original or transformed name.
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 (AnyPosting  qs) p = all (`matchesPosting` p) qs
matchesPosting (AllPostings qs) p = all1 (`matchesPosting` p) qs
matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p
matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p
matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p) where matches = regexMatchText r . paccount
matchesPosting (Date spn) p = spn `spanContainsDate` postingDate p
matchesPosting (Date2 spn) p = spn `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@(DepthAcct _ _) Posting{paccount=a} = q `matchesAccount` a
matchesPosting q@(Amt _ _) Posting{pamount=as} = q `matchesMixedAmount` as
matchesPosting (Sym r) Posting{pamount=as} = any (matchesCommodity (Sym r) . acommodity) $ amountsRaw as
matchesPosting (Tag n v) p = case (reString n, v) of
  ("payee", Just v') -> maybe False (regexMatchText v' . transactionPayee) $ ptransaction p
  ("note", Just v') -> maybe False (regexMatchText v' . transactionNote) $ ptransaction p
  (_, mv) -> patternsMatchTags n mv $ postingAllTags p
matchesPosting (Type _) _ = False

-- | Like matchesPosting, but if the posting's account's type is provided,
-- any type: terms in the query must match it (and any negated type: terms
-- must not match it).
matchesPostingExtra :: (AccountName -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra atype (Not q )  p = not $ matchesPostingExtra atype q p
matchesPostingExtra atype (Or  qs)  p = any (\q -> matchesPostingExtra atype q p) qs
matchesPostingExtra atype (And qs)  p = all (\q -> matchesPostingExtra atype q p) qs
matchesPostingExtra atype (AnyPosting  qs)  p = all (\q -> matchesPostingExtra atype q p) qs
matchesPostingExtra atype (AllPostings qs)  p = all1 (\q -> matchesPostingExtra atype q p) qs
matchesPostingExtra atype (Type ts) p =
  -- does posting's account's type, if we can detect it, match any of the given types ?
  (maybe False (\t -> any (t `isAccountSubtypeOf`) ts) . atype $ paccount p)
  -- or, try the same test with the original (pre-aliasing/pivoting) posting's account
  || (fromMaybe False $ do
      porig <- poriginal p
      let a = paccount porig
      t <- atype a
      Just $ any (t `isAccountSubtypeOf`) ts
  )
matchesPostingExtra _ q p             = matchesPosting q p

-- | Does the match expression match this transaction ?
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 (AnyPosting  qs) t = any (\p -> all (`matchesPosting` p) qs) $ tpostings t
matchesTransaction (AllPostings qs) t = all1 (\p -> all (`matchesPosting` p) qs) $ tpostings t
matchesTransaction (Code r) t = regexMatchText r $ tcode t
matchesTransaction (Desc r) t = regexMatchText r $ tdescription t
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Date spn) t = spanContainsDate spn $ tdate t
matchesTransaction (Date2 spn) t = spanContainsDate spn $ 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 q@(Depth _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction q@(DepthAcct _ _) t = any (q `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') -> regexMatchText v' $ transactionPayee t
  ("note", Just v') -> regexMatchText v' $ transactionNote t
  (_, v') -> patternsMatchTags n v' $ transactionAllTags t
matchesTransaction (Type _) _ = False

-- | Like matchesTransaction, but if the journal's account types are provided,
-- any type: terms in the query must match at least one posting's account type
-- (and any negated type: terms must match none).
matchesTransactionExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra atype (Not  q) t = not $ matchesTransactionExtra atype q t
matchesTransactionExtra atype (Or  qs) t = any (\q -> matchesTransactionExtra atype q t) qs
matchesTransactionExtra atype (And qs) t = all (\q -> matchesTransactionExtra atype q t) qs
matchesTransactionExtra atype (AnyPosting  qs) t = any (\p -> all (\q -> matchesPostingExtra atype q p) qs) $ tpostings t
matchesTransactionExtra atype (AllPostings qs) t = all1 (\p -> all (\q -> matchesPostingExtra atype q p) qs) $ tpostings t
matchesTransactionExtra atype q@(Type _) t = any (matchesPostingExtra atype q) $ tpostings t
matchesTransactionExtra _ q t = matchesTransaction q t

-- | Does the query match this transaction description ?
-- Non-desc: query terms are ignored (this might disrupt some boolean queries).
matchesDescription :: Query -> Text -> Bool
matchesDescription (Not q) d          = not $ q `matchesDescription` d
matchesDescription (Any) _            = True
matchesDescription (None) _           = False
matchesDescription (Or qs) d          = any (`matchesDescription` d) $ filter queryIsDesc qs
matchesDescription (And qs) d         = all (`matchesDescription` d) $ filter queryIsDesc qs
matchesDescription (AnyPosting  qs) d = all (`matchesDescription` d) $ filter queryIsDesc qs
matchesDescription (AllPostings qs) d = all1 (`matchesDescription` d) $ filter queryIsDesc qs
matchesDescription (Code _) _         = False
matchesDescription (Desc r) d         = regexMatchText r d
matchesDescription _ _                = False

-- | Does the query match this transaction payee ?
-- Tests desc: (and payee: ?) terms, any other terms are ignored.
-- XXX Currently an alias for matchDescription. I'm not sure if more is needed,
-- There's some shenanigan with payee: and "payeeTag" to figure out.
matchesPayeeWIP :: Query -> Payee -> Bool
matchesPayeeWIP = matchesDescription

-- | Do this name regex and optional value regex match the name and value of any of these tags ?
patternsMatchTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
patternsMatchTags namepat valuepat = any (matches namepat valuepat)
  where
    matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v

-- | Does the query match the name and optionally the value of this tag ?
-- Non-tag: query terms are ignored (this might disrupt some boolean queries).
matchesTag :: Query -> Tag -> Bool
matchesTag (Not q)          t = not $ q `matchesTag` t
matchesTag (Any)            _ = True
matchesTag (None)           _ = False
matchesTag (Or qs)          t = any (`matchesTag` t) $ filter queryIsTag qs
matchesTag (And qs)         t = all (`matchesTag` t) $ filter queryIsTag qs
matchesTag (AnyPosting qs)  t = all (`matchesTag` t) $ filter queryIsTag qs
matchesTag (AllPostings qs) t = all1 (`matchesTag` t) $ filter queryIsTag qs
matchesTag (Tag npat mvpat) t = patternsMatchTags npat mvpat [t]
matchesTag _                _ = False

-- | Does the query match this market price ?
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 (AnyPosting  qs) p = all (`matchesPriceDirective` p) qs
matchesPriceDirective (AllPostings qs) p = all1 (`matchesPriceDirective` p) qs
matchesPriceDirective q@(Amt _ _) p      = matchesAmount q (pdamount p)
matchesPriceDirective q@(Sym _) p        = matchesCommodity q (pdcommodity p)
matchesPriceDirective (Date spn) p       = spanContainsDate spn (pddate p)
matchesPriceDirective _ _                = True


-- tests

tests_Query = testGroup "Query" [
   testCase "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 $ Exact $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) Nothing)])
       @?= (Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) (Just $ Exact $ fromGregorian 2013 01 01)))
     (simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")

  ,testCase "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' "\"", [])

  ,testCase "parseBooleanQuery" $ do
     parseBooleanQuery nulldate "(tag:'atag=a')"     @?= Right (Tag (toRegexCI' "atag") (Just $ toRegexCI' "a"), [])
     parseBooleanQuery nulldate "(  tag:\"atag=a\"  )"     @?= Right (Tag (toRegexCI' "atag") (Just $ toRegexCI' "a"), [])
     parseBooleanQuery nulldate "(acct:'expenses:food')"     @?= Right (Acct $ toRegexCI' "expenses:food", [])
     parseBooleanQuery nulldate "(((acct:'expenses:food')))" @?= Right (Acct $ toRegexCI' "expenses:food", [])
     parseBooleanQuery nulldate "acct:'expenses:food' AND desc:'b'" @?= Right (And [Acct $ toRegexCI' "expenses:food", Desc $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate "((desc:'a') AND (desc:'b') OR (desc:'c'))" @?= Right (Or [And [Desc $ toRegexCI' "a", Desc $ toRegexCI' "b"], Desc $ toRegexCI' "c"], [])
     parseBooleanQuery nulldate "((desc:'a') OR (desc:'b') AND (desc:'c'))" @?= Right (Or [Desc $ toRegexCI' "a", And [Desc $ toRegexCI' "b", Desc $ toRegexCI' "c"]], [])
     parseBooleanQuery nulldate "((desc:'a') AND desc:'b' AND (desc:'c'))" @?= Right (And [Desc $ toRegexCI' "a", Desc $ toRegexCI' "b", Desc $ toRegexCI' "c"], [])
     parseBooleanQuery nulldate "(NOT (desc:'a') AND (desc:'b'))" @?= Right (And [Not $ Desc $ toRegexCI' "a", Desc $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate "((desc:'a') AND (NOT desc:'b'))" @?= Right (And [Desc $ toRegexCI' "a", Not $ Desc $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate "(desc:'a' AND desc:'b')" @?= Right (And [Desc $ toRegexCI' "a", Desc $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate "(acct:'a' acct:'b')" @?= Right (Or [Acct $ toRegexCI' "a", Acct $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate " acct:'a' acct:'b'" @?= Right (Or [Acct $ toRegexCI' "a", Acct $ toRegexCI' "b"], [])
     parseBooleanQuery nulldate "not:a" @?= Right (Not $ Acct $ toRegexCI' "a", [])
     parseBooleanQuery nulldate "expenses:food OR (tag:A expenses:drink)" @?= Right (Or [Acct $ toRegexCI' "expenses:food", And [Acct $ toRegexCI' "expenses:drink", Tag (toRegexCI' "A") Nothing]], [])
     parseBooleanQuery nulldate "not a" @?= Right (Not $ Acct $ toRegexCI' "a", [])
     parseBooleanQuery nulldate "nota" @?= Right (Acct $ toRegexCI' "nota", [])
     parseBooleanQuery nulldate "not (acct:a)" @?= Right (Not $ Acct $ toRegexCI' "a", [])

  ,testCase "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'' queryprefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"]
      (words'' queryprefixes "\"")              @?= ["\""]

  ,testCase "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   -- XXX unclear

  ,testCase "parseQueryTerm" $ do
     parseQueryTerm nulldate "a"                                @?= Right (Acct $ toRegexCI' "a", [])
     parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Acct $ toRegexCI' "expenses:autres d\233penses", [])
     parseQueryTerm nulldate "not:desc:a b"                     @?= Right (Not $ Desc $ toRegexCI' "a b", [])
     parseQueryTerm nulldate "status:1"                         @?= Right (StatusQ Cleared, [])
     parseQueryTerm nulldate "status:*"                         @?= Right (StatusQ Cleared, [])
     parseQueryTerm nulldate "status:!"                         @?= Right (StatusQ Pending, [])
     parseQueryTerm nulldate "status:0"                         @?= Right (StatusQ Unmarked, [])
     parseQueryTerm nulldate "status:"                          @?= Right (StatusQ Unmarked, [])
     parseQueryTerm nulldate "payee:x"                          @?= (,[]) <$> payeeTag (Just "x")
     parseQueryTerm nulldate "note:x"                           @?= (,[]) <$> noteTag (Just "x")
     parseQueryTerm nulldate "real:1"                           @?= Right (Real True, [])
     parseQueryTerm nulldate "date:2008"                        @?= Right (Date $ DateSpan (Just $ Flex $ fromGregorian 2008 01 01) (Just $ Flex $ fromGregorian 2009 01 01), [])
     parseQueryTerm nulldate "date:from 2012/5/17"              @?= Right (Date $ DateSpan (Just $ Exact $ fromGregorian 2012 05 17) Nothing, [])
     parseQueryTerm nulldate "date:20180101-201804"             @?= Right (Date $ DateSpan (Just $ Exact $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 04 01), [])
     parseQueryTerm nulldate "inacct:a"                         @?= Right (Any, [QueryOptInAcct "a"])
     parseQueryTerm nulldate "tag:a"                            @?= Right (Tag (toRegexCI' "a") Nothing, [])
     parseQueryTerm nulldate "tag:a=some value"                 @?= Right (Tag (toRegexCI' "a") (Just $ toRegexCI' "some value"), [])
     parseQueryTerm nulldate "amt:<0"                           @?= Right (Amt Lt 0, [])
     parseQueryTerm nulldate "amt:>10000.10"                    @?= Right (Amt AbsGt 10000.1, [])

  ,testCase "parseAmountQueryTerm" $ do
     parseAmountQueryTerm "<0"        @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false
     parseAmountQueryTerm ">0"        @?= Right (Gt,0) -- special case for convenience and consistency with above
     parseAmountQueryTerm " > - 0 "   @?= Right (Gt,0) -- accept whitespace around the argument parts
     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"

  ,testCase "queryStartDate" $ do
     let small = Just $ fromGregorian 2000 01 01
         big   = Just $ fromGregorian 2000 01 02
     queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= big
     queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing])         @?= small
     queryStartDate False (Or  [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= small
     queryStartDate False (Or  [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing])         @?= Nothing

  ,testCase "queryEndDate" $ do
     let small = Just $ fromGregorian 2000 01 01
         big   = Just $ fromGregorian 2000 01 02
     queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= small
     queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing])         @?= small
     queryEndDate False (Or  [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= big
     queryEndDate False (Or  [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing])         @?= Nothing

  ,testCase "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"

  ,testCase "matchesAccountExtra" $ do
     let tagq = Tag (toRegexCI' "type") Nothing
     assertBool "" $ not $ matchesAccountExtra (const Nothing) (const []) tagq "a"
     assertBool "" $       matchesAccountExtra (const Nothing) (const [("type","")]) tagq "a"

  ,testGroup "matchesPosting" [
     testCase "positive match on cleared posting status"  $
      assertBool "" $ (StatusQ Cleared)  `matchesPosting` nullposting{pstatus=Cleared}
    ,testCase "negative match on cleared posting status"  $
      assertBool "" $ not $ (Not $ StatusQ Cleared)  `matchesPosting` nullposting{pstatus=Cleared}
    ,testCase "positive match on unmarked posting status" $
      assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
    ,testCase "negative match on unmarked posting status" $
      assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
    ,testCase "positive match on true posting status acquired from transaction" $
      assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}}
    ,testCase "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
    ,testCase "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
    ,testCase "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
    ,testCase "acct:" $ assertBool "" $ (Acct $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
    ,testCase "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")]}
    ,testCase "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
    ,testCase "cur:" $ do
      let toSym = fst . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
      assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol
      assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr
      assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
      assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
  ]

  ,testCase "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"}
     -- see posting for more tag tests
     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"}
     -- a tag match on a transaction also matches posting tags
     assertBool "" $ (Tag (toRegex' "postingtag") Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}

     -- hledger print expr:'cash and amt:>0' means "show transactions with (at least one posting involving a cash account) and (at least one posting with a positive amount)"
     let exprq = And [Acct $ toRegex' "cash", Amt Gt 0]
     assertBool "" $ exprq `matchesTransaction` nulltransaction{tpostings=[nullposting{paccount="cash", pamount=1}]}
     assertBool "" $ exprq `matchesTransaction` nulltransaction{tpostings = [nullposting{paccount="cash"}, nullposting{paccount="food", pamount=1}]}

     -- hledger print any:'cash and amt:>0' means "show transactions where at least one posting posts a positive amount to a cash account".
     let anyq = AnyPosting [Acct $ toRegex' "cash", Amt Gt 0]
     assertBool "" $ anyq `matchesTransaction` nulltransaction{tpostings=[nullposting{paccount="cash", pamount=1}]}
     assertBool "" $ not $ anyq `matchesTransaction` nulltransaction{tpostings = [nullposting{paccount="cash"}, nullposting{paccount="food", pamount=1}]}

     -- hledger print all:'cash and amt:0' means "show transactions where all postings involve a cash account and have a zero amount".
     assertBool "" $ AllPostings [Amt Eq 0] `matchesTransaction`
      nulltransaction{tpostings = [nullposting{paccount = "cash"}, nullposting{paccount = "food"}]}
     assertBool "" $ not $ AllPostings [Acct $ toRegex' "cash", Amt Eq 0] `matchesTransaction`
      nulltransaction{tpostings = [nullposting{paccount = "cash"}, nullposting{paccount = "food"}]}
 ]