{-|

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,
  -- * modifying
  simplifyQuery,
  filterQuery,
  filterQueryOrNotQuery,
  matchesQuery,
  -- * predicates
  queryIsNull,
  queryIsDate,
  queryIsDate2,
  queryIsDateOrDate2,
  queryIsStatus,
  queryIsCode,
  queryIsDesc,
  queryIsTag,
  queryIsAcct,
  queryIsType,
  queryIsDepth,
  queryIsReal,
  queryIsAmt,
  queryIsSym,
  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,
  matchesTags,
  matchesPriceDirective,
  words'',
  queryprefixes,
  -- * tests
  tests_Query
)
where

import Control.Applicative ((<|>), many, optional)
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 (readDef, 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


-- | A query is a composition of search criteria, which can be used to
-- match postings, transactions, accounts and more.
data Query = 
  -- compound queries
    Not Query                 -- ^ negate this match
  | And [Query]               -- ^ match if all of these match
  | Or  [Query]               -- ^ match if any of these match
  -- 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)
  | 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
  deriving (Query -> Query -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Eq,Int -> Query -> ShowS
[Query] -> ShowS
Query -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> [Char]
$cshow :: Query -> [Char]
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show)

instance Default Query where def :: Query
def = Query
Any

-- | Construct a payee tag
payeeTag :: Maybe Text -> Either RegexError Query
payeeTag :: Maybe Text -> Either [Char] Query
payeeTag = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"payee")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] Regexp
toRegexCI)

-- | Construct a note tag
noteTag :: Maybe Text -> Either RegexError Query
noteTag :: Maybe Text -> Either [Char] Query
noteTag = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"note")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] Regexp
toRegexCI)

-- | Construct a generated-transaction tag
generatedTransactionTag :: Query
generatedTransactionTag :: Query
generatedTransactionTag = Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"generated-transaction") forall a. Maybe a
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 (Int -> OrdPlus -> ShowS
[OrdPlus] -> ShowS
OrdPlus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OrdPlus] -> ShowS
$cshowList :: [OrdPlus] -> ShowS
show :: OrdPlus -> [Char]
$cshow :: OrdPlus -> [Char]
showsPrec :: Int -> OrdPlus -> ShowS
$cshowsPrec :: Int -> OrdPlus -> ShowS
Show,OrdPlus -> OrdPlus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrdPlus -> OrdPlus -> Bool
$c/= :: OrdPlus -> OrdPlus -> Bool
== :: OrdPlus -> OrdPlus -> Bool
$c== :: OrdPlus -> OrdPlus -> Bool
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 (Int -> QueryOpt -> ShowS
[QueryOpt] -> ShowS
QueryOpt -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QueryOpt] -> ShowS
$cshowList :: [QueryOpt] -> ShowS
show :: QueryOpt -> [Char]
$cshow :: QueryOpt -> [Char]
showsPrec :: Int -> QueryOpt -> ShowS
$cshowsPrec :: Int -> QueryOpt -> ShowS
Show, QueryOpt -> QueryOpt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryOpt -> QueryOpt -> Bool
$c/= :: QueryOpt -> QueryOpt -> Bool
== :: QueryOpt -> QueryOpt -> Bool
$c== :: QueryOpt -> QueryOpt -> Bool
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 :: Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
d Text
t = Day -> [Text] -> Either [Char] (Query, [QueryOpt])
parseQueryList Day
d forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> [Text]
words'' [Text]
queryprefixes Text
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 :: Day -> [Text] -> Either [Char] (Query, [QueryOpt])
parseQueryList Day
d [Text]
termstrs = do
  [(Query, [QueryOpt])]
eterms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
d) [Text]
termstrs
  let ([Query]
pats, [[QueryOpt]]
optss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Query, [QueryOpt])]
eterms
      q :: Query
q = [Query] -> Query
combineQueryList [Query]
pats
  forall a b. b -> Either a b
Right (Query
q, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[QueryOpt]]
optss)

combineQueryList :: [Query] -> Query
combineQueryList :: [Query] -> Query
combineQueryList [Query]
pats = Query
q
  where
    ([Query]
descpats, [Query]
pats') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Query -> Bool
queryIsDesc [Query]
pats
    ([Query]
acctpats, [Query]
pats'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Query -> Bool
queryIsAcct [Query]
pats'
    ([Query]
statuspats, [Query]
otherpats) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Query -> Bool
queryIsStatus [Query]
pats''
    q :: Query
q = Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ [[Query] -> Query
Or [Query]
acctpats, [Query] -> Query
Or [Query]
descpats, [Query] -> Query
Or [Query]
statuspats] forall a. [a] -> [a] -> [a]
++ [Query]
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'' :: [Text] -> Text -> [Text]
words'' [Text]
prefixes = forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith SimpleTextParser [Text]
maybePrefixedQuotedPhrases -- XXX
   where
      maybePrefixedQuotedPhrases :: SimpleTextParser [T.Text]
      maybePrefixedQuotedPhrases :: SimpleTextParser [Text]
maybePrefixedQuotedPhrases = forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' [ParsecT HledgerParseErrorData Text Identity Text
prefixedQuotedPattern, ParsecT HledgerParseErrorData Text Identity Text
singleQuotedPattern, ParsecT HledgerParseErrorData Text Identity Text
doubleQuotedPattern, ParsecT HledgerParseErrorData Text Identity Text
patterns] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy`
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1)
      prefixedQuotedPattern :: SimpleTextParser T.Text
      prefixedQuotedPattern :: ParsecT HledgerParseErrorData Text Identity Text
prefixedQuotedPattern = do
        Text
not' <- forall a. a -> Maybe a -> a
fromMaybe Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"not:")
        let allowednexts :: [Text]
allowednexts | Text -> Bool
T.null Text
not' = [Text]
prefixes
                         | Bool
otherwise   = [Text]
prefixes forall a. [a] -> [a] -> [a]
++ [Text
""]
        Text
next <- forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
allowednexts
        let prefix :: T.Text
            prefix :: Text
prefix = Text
not' forall a. Semigroup a => a -> a -> a
<> Text
next
        Text
p <- ParsecT HledgerParseErrorData Text Identity Text
singleQuotedPattern forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text Identity Text
doubleQuotedPattern
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
prefix forall a. Semigroup a => a -> a -> a
<> Text -> Text
stripquotes Text
p
      singleQuotedPattern :: SimpleTextParser T.Text
      singleQuotedPattern :: ParsecT HledgerParseErrorData Text Identity Text
singleQuotedPattern = Text -> Text
stripquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"'" :: [Char]))
      doubleQuotedPattern :: SimpleTextParser T.Text
      doubleQuotedPattern :: ParsecT HledgerParseErrorData Text Identity Text
doubleQuotedPattern = Text -> Text
stripquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"\"" :: [Char]))
      patterns :: SimpleTextParser T.Text
      patterns :: ParsecT HledgerParseErrorData Text Identity Text
patterns = [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
" \n\r" :: [Char]))

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

defaultprefix :: T.Text
defaultprefix :: Text
defaultprefix = Text
"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 :: Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"inacctonly:" -> Just Text
s) = forall a b. b -> Either a b
Right (Query
Any, [Text -> QueryOpt
QueryOptInAcctOnly Text
s])
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"inacct:" -> Just Text
s) = forall a b. b -> Either a b
Right (Query
Any, [Text -> QueryOpt
QueryOptInAcct Text
s])
parseQueryTerm Day
d (Text -> Text -> Maybe Text
T.stripPrefix Text
"not:" -> Just Text
s) =
  case Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
d Text
s of
    Right (Query
q, [QueryOpt]
qopts) -> forall a b. b -> Either a b
Right (Query -> Query
Not Query
q, [QueryOpt]
qopts)
    Left [Char]
err         -> forall a b. a -> Either a b
Left [Char]
err
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"code:" -> Just Text
s) = (,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Regexp
toRegexCI Text
s
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"desc:" -> Just Text
s) = (,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Desc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Regexp
toRegexCI Text
s
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"payee:" -> Just Text
s) = (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Either [Char] Query
payeeTag (forall a. a -> Maybe a
Just Text
s)
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"note:" -> Just Text
s) = (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Either [Char] Query
noteTag (forall a. a -> Maybe a
Just Text
s)
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"acct:" -> Just Text
s) = (,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Acct forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Regexp
toRegexCI Text
s
parseQueryTerm Day
d (Text -> Text -> Maybe Text
T.stripPrefix Text
"date2:" -> Just Text
s) =
        case Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d Text
s of Left HledgerParseErrors
e         -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"\"date2:"forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
sforall a. [a] -> [a] -> [a]
++[Char]
"\" gave a "forall a. [a] -> [a] -> [a]
++forall t e.
(Show t, Show (Token t), Show e) =>
ParseErrorBundle t e -> [Char]
showDateParseError HledgerParseErrors
e
                                    Right (Interval
_,DateSpan
spn) -> forall a b. b -> Either a b
Right (DateSpan -> Query
Date2 DateSpan
spn, [])
parseQueryTerm Day
d (Text -> Text -> Maybe Text
T.stripPrefix Text
"date:" -> Just Text
s) =
        case Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d Text
s of Left HledgerParseErrors
e         -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"\"date:"forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
sforall a. [a] -> [a] -> [a]
++[Char]
"\" gave a "forall a. [a] -> [a] -> [a]
++forall t e.
(Show t, Show (Token t), Show e) =>
ParseErrorBundle t e -> [Char]
showDateParseError HledgerParseErrors
e
                                    Right (Interval
_,DateSpan
spn) -> forall a b. b -> Either a b
Right (DateSpan -> Query
Date DateSpan
spn, [])
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"status:" -> Just Text
s) =
        case Text -> Either [Char] Status
parseStatus Text
s of Left [Char]
e   -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"\"status:"forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
sforall a. [a] -> [a] -> [a]
++[Char]
"\" gave a parse error: " forall a. [a] -> [a] -> [a]
++ [Char]
e
                              Right Status
st -> forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
st, [])
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"real:" -> Just Text
s) = forall a b. b -> Either a b
Right (Bool -> Query
Real forall a b. (a -> b) -> a -> b
$ Text -> Bool
parseBool Text
s Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
s, [])
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"amt:" -> Just Text
s) = forall a b. b -> Either a b
Right (OrdPlus -> Quantity -> Query
Amt OrdPlus
ord Quantity
q, []) where (OrdPlus
ord, Quantity
q) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
s  -- PARTIAL:
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"depth:" -> Just Text
s)
  | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0    = forall a b. b -> Either a b
Right (Int -> Query
Depth Int
n, [])
  | Bool
otherwise = forall a b. a -> Either a b
Left [Char]
"depth: should have a positive number"
  where n :: Int
n = forall a. Read a => a -> [Char] -> a
readDef Int
0 (Text -> [Char]
T.unpack Text
s)

parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"cur:" -> Just Text
s) = (,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Sym forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Regexp
toRegexCI (Text
"^" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"$") -- support cur: as an alias
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"tag:" -> Just Text
s) = (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Query
parseTag Text
s
parseQueryTerm Day
_ (Text -> Text -> Maybe Text
T.stripPrefix Text
"type:" -> Just Text
s) = (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Query
parseTypeCodes Text
s
parseQueryTerm Day
d (Text -> Text -> Maybe Text
T.stripPrefix Text
"expr:" -> Just Text
s) = Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
d Text
s
parseQueryTerm Day
_ Text
"" = forall a b. b -> Either a b
Right (Query
Any, [])
parseQueryTerm Day
d Text
s = Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
d forall a b. (a -> b) -> a -> b
$ Text
defaultprefixforall a. Semigroup a => a -> a -> a
<>Text
":"forall a. Semigroup a => a -> a -> a
<>Text
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-separation operator is left as it was the default before the introduction of
-- boolean operators. It takes the behaviour defined in the interpretQueryList function,
-- whereas the NOT, OR, and AND operators simply wrap a list of queries with the associated
--
--
-- 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 :: Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
d Text
t = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"failed to parse query:" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HledgerParseErrors -> [Char]
customErrorBundlePretty) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith SimpleTextParser (Query, [QueryOpt])
spacedQueriesP Text
t
  where
    regexP       :: SimpleTextParser T.Text
    regexP :: ParsecT HledgerParseErrorData Text Identity Text
regexP       = forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice'
      [ Text -> Text
stripquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"'" :: [Char])),
        Text -> Text
stripquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"\"" :: [Char])),
        [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT HledgerParseErrorData Text Identity Text
keywordSpaceP forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
") \n\r" :: [Char]))) ]
    queryPrefixP :: SimpleTextParser T.Text
    queryPrefixP :: ParsecT HledgerParseErrorData Text Identity Text
queryPrefixP = (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"not:" forall a. Semigroup a => a -> a -> a
<> (forall a. a -> Maybe a -> a
fromMaybe Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text Identity Text
queryPrefixP))
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
queryprefixes)
               forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"query prefix"
    queryTermP   :: SimpleTextParser (Query, [QueryOpt])
    queryTermP :: SimpleTextParser (Query, [QueryOpt])
queryTermP   = do
      Maybe Text
prefix <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text Identity Text
queryPrefixP
      Text
queryRegex <- ParsecT HledgerParseErrorData Text Identity Text
regexP

      case Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
d (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
queryRegex) of
        Right (Query, [QueryOpt])
q  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Query, [QueryOpt])
q
        Left [Char]
err -> forall a. [Char] -> a
error' [Char]
err

    keywordSpaceP :: SimpleTextParser T.Text
    keywordSpaceP :: ParsecT HledgerParseErrorData Text Identity Text
keywordSpaceP = forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' (forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tokens Text
"not ", Tokens Text
"and ", Tokens Text
"or "])

    parQueryP,notQueryP :: SimpleTextParser (Query, [QueryOpt])
    parQueryP :: SimpleTextParser (Query, [QueryOpt])
parQueryP = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces)
                        (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')')
                        SimpleTextParser (Query, [QueryOpt])
spacedQueriesP
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser (Query, [QueryOpt])
queryTermP
    notQueryP :: SimpleTextParser (Query, [QueryOpt])
notQueryP = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\()
_ (Query
q, [QueryOpt]
qopts) -> (Query -> Query
Not Query
q, [QueryOpt]
qopts)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"not" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SimpleTextParser (Query, [QueryOpt])
parQueryP

    andQueriesP,orQueriesP,spacedQueriesP :: SimpleTextParser (Query, [QueryOpt])
    andQueriesP :: SimpleTextParser (Query, [QueryOpt])
andQueriesP    = ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
nArityOp [Query] -> Query
And forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleTextParser (Query, [QueryOpt])
notQueryP forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"and" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1)
    orQueriesP :: SimpleTextParser (Query, [QueryOpt])
orQueriesP     = ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
nArityOp [Query] -> Query
Or forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleTextParser (Query, [QueryOpt])
andQueriesP forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"or" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1)
    spacedQueriesP :: SimpleTextParser (Query, [QueryOpt])
spacedQueriesP = ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
nArityOp [Query] -> Query
combineQueryList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleTextParser (Query, [QueryOpt])
orQueriesP forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1

    nArityOp       :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
    nArityOp :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
nArityOp [Query] -> Query
f [(Query, [QueryOpt])]
res = let ([Query]
qs, [[QueryOpt]]
qoptss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Query, [QueryOpt])]
res
                         qoptss' :: [QueryOpt]
qoptss'      = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[QueryOpt]]
qoptss
                      in case [Query]
qs of
                         []     -> (Query
Any, [QueryOpt]
qoptss')
                         (Query
q:[]) -> (Query -> Query
simplifyQuery Query
q, [QueryOpt]
qoptss')
                         [Query]
_      -> (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
f [Query]
qs, [QueryOpt]
qoptss')

-- | 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 :: Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
amtarg =
  case Text
amtarg of
    -- number has a + sign, do a signed comparison
    (Text -> Text -> Maybe Quantity
parse Text
"<=+" -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
LtEq    ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"<+"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Lt      ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">=+" -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
GtEq    ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">+"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Gt      ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"=+"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Eq      ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"+"   -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Eq      ,Quantity
q)
    -- number has a - sign, do a signed comparison
    (Text -> Text -> Maybe Quantity
parse Text
"<-"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Lt      ,-Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"<=-" -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
LtEq    ,-Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">-"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Gt      ,-Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">=-" -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
GtEq    ,-Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"=-"  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Eq      ,-Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"-"   -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
Eq      ,-Quantity
q)
    -- number is unsigned and zero, do a signed comparison (more useful)
    (Text -> Text -> Maybe Quantity
parse Text
"<="  -> Just Quantity
0) -> forall a b. b -> Either a b
Right (OrdPlus
LtEq    ,Quantity
0)
    (Text -> Text -> Maybe Quantity
parse Text
"<"   -> Just Quantity
0) -> forall a b. b -> Either a b
Right (OrdPlus
Lt      ,Quantity
0)
    (Text -> Text -> Maybe Quantity
parse Text
">="  -> Just Quantity
0) -> forall a b. b -> Either a b
Right (OrdPlus
GtEq    ,Quantity
0)
    (Text -> Text -> Maybe Quantity
parse Text
">"   -> Just Quantity
0) -> forall a b. b -> Either a b
Right (OrdPlus
Gt      ,Quantity
0)
    -- number is unsigned and non-zero, do an absolute magnitude comparison
    (Text -> Text -> Maybe Quantity
parse Text
"<="  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsLtEq ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"<"   -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsLt   ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">="  -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsGtEq ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
">"   -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsGt   ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
"="   -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsEq   ,Quantity
q)
    (Text -> Text -> Maybe Quantity
parse Text
""    -> Just Quantity
q) -> forall a b. b -> Either a b
Right (OrdPlus
AbsEq   ,Quantity
q)
    Text
_ -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$
         Text
"could not parse as a comparison operator followed by an optionally-signed number: " forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> Text -> Maybe Quantity
parse Text
p Text
s = (Text -> Text -> Maybe Text
T.stripPrefix Text
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) Text
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/=Char
' ')

parseTag :: T.Text -> Either RegexError Query
parseTag :: Text -> Either [Char] Query
parseTag Text
s = do
    Regexp
tag <- Text -> Either [Char] Regexp
toRegexCI forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
v then Text
s else Text
n
    Maybe Regexp
body <- if Text -> Bool
T.null Text
v then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] Regexp
toRegexCI (Text -> Text
T.tail Text
v)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Regexp -> Maybe Regexp -> Query
Tag Regexp
tag Maybe Regexp
body
  where (Text
n,Text
v) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
'=') Text
s

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

accountTypeChoices :: Bool -> String
accountTypeChoices :: Bool -> [Char]
accountTypeChoices Bool
allowlongform = 
  forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " 
    -- keep synced with parseAccountType
    forall a b. (a -> b) -> a -> b
$ [[Char]
"A",[Char]
"L",[Char]
"E",[Char]
"R",[Char]
"X",[Char]
"C",[Char]
"V"]
    forall a. [a] -> [a] -> [a]
++ if Bool
allowlongform then [[Char]
"Asset",[Char]
"Liability",[Char]
"Equity",[Char]
"Revenue",[Char]
"Expense",[Char]
"Cash",[Char]
"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 :: Bool -> Text -> Either [Char] AccountType
parseAccountType Bool
allowlongform Text
s =
  case Text -> Text
T.toLower Text
s of
    -- keep synced with accountTypeChoices
    Text
"a"                          -> forall a b. b -> Either a b
Right AccountType
Asset
    Text
"l"                          -> forall a b. b -> Either a b
Right AccountType
Liability
    Text
"e"                          -> forall a b. b -> Either a b
Right AccountType
Equity
    Text
"r"                          -> forall a b. b -> Either a b
Right AccountType
Revenue
    Text
"x"                          -> forall a b. b -> Either a b
Right AccountType
Expense
    Text
"c"                          -> forall a b. b -> Either a b
Right AccountType
Cash
    Text
"v"                          -> forall a b. b -> Either a b
Right AccountType
Conversion
    Text
"asset"      | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Asset
    Text
"liability"  | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Liability
    Text
"equity"     | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Equity
    Text
"revenue"    | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Revenue
    Text
"expense"    | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Expense
    Text
"cash"       | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Cash
    Text
"conversion" | Bool
allowlongform -> forall a b. b -> Either a b
Right AccountType
Conversion
    Text
_                            -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

-- | Parse the value part of a "status:" query, or return an error.
parseStatus :: T.Text -> Either String Status
parseStatus :: Text -> Either [Char] Status
parseStatus Text
s | Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"*",Text
"1"] = forall a b. b -> Either a b
Right Status
Cleared
              | Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"",Text
"0"]  = forall a b. b -> Either a b
Right Status
Unmarked
              | Text
s forall a. Eq a => a -> a -> Bool
== Text
"!"           = forall a b. b -> Either a b
Right Status
Pending
              | Bool
otherwise          = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Text
sforall a. [a] -> [a] -> [a]
++[Char]
" 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 :: Text -> Bool
parseBool Text
s = Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
truestrings

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

-- * modifying

simplifyQuery :: Query -> Query
simplifyQuery :: Query -> Query
simplifyQuery Query
q0 =
  let q1 :: Query
q1 = Query -> Query
simplify Query
q0
  in if Query
q1 forall a. Eq a => a -> a -> Bool
== Query
q0 then Query
q0 else Query -> Query
simplifyQuery Query
q1
  where
    simplify :: Query -> Query
simplify (And []) = Query
Any
    simplify (And [Query
q]) = Query -> Query
simplify Query
q
    simplify (And [Query]
qs) | forall {a}. Eq a => [a] -> Bool
same [Query]
qs = Query -> Query
simplify forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Query]
qs
                      | Query
None forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Query]
qs = Query
None
                      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryIsDate [Query]
qs = DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ [DateSpan] -> DateSpan
spansIntersect forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Query -> Maybe DateSpan
queryTermDateSpan [Query]
qs
                      | Bool
otherwise = [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Query -> Query
simplify [Query]
dateqs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Query -> Query
simplify [Query]
otherqs
                      where ([Query]
dateqs, [Query]
otherqs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Query -> Bool
queryIsDate forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Query
Any) [Query]
qs
    simplify (Or []) = Query
Any
    simplify (Or [Query
q]) = Query -> Query
simplifyQuery Query
q
    simplify (Or [Query]
qs) | forall {a}. Eq a => [a] -> Bool
same [Query]
qs = Query -> Query
simplify forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Query]
qs
                     | Query
Any forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Query]
qs = Query
Any
                     -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs  ?
                     | Bool
otherwise = [Query] -> Query
Or forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Query -> Query
simplify forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Query
None) [Query]
qs
    simplify (Date (DateSpan Maybe EFDay
Nothing Maybe EFDay
Nothing)) = Query
Any
    simplify (Date2 (DateSpan Maybe EFDay
Nothing Maybe EFDay
Nothing)) = Query
Any
    simplify Query
q = Query
q

same :: [a] -> Bool
same [] = Bool
True
same (a
a:[a]
as) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
aforall a. Eq a => a -> a -> Bool
==) [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 :: (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
p = Query -> Query
simplifyQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery' Query -> Bool
p

-- | Like filterQuery, but returns the filtered query as is, without simplifying.
filterQuery' :: (Query -> Bool) -> Query -> Query
filterQuery' :: (Query -> Bool) -> Query -> Query
filterQuery' Query -> Bool
p (And [Query]
qs) = [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
p) [Query]
qs
filterQuery' Query -> Bool
p (Or [Query]
qs) = [Query] -> Query
Or forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
p) [Query]
qs
filterQuery' Query -> Bool
p Query
q = if Query -> Bool
p Query
q then Query
q else Query
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 :: (Query -> Bool) -> Query -> Query
filterQueryOrNotQuery Query -> Bool
p0 = Query -> Query
simplifyQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQueryOrNotQuery' Query -> Bool
p0
  where
    filterQueryOrNotQuery' :: (Query -> Bool) -> Query -> Query
    filterQueryOrNotQuery' :: (Query -> Bool) -> Query -> Query
filterQueryOrNotQuery' Query -> Bool
p (And [Query]
qs)      = [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Query -> Bool) -> Query -> Query
filterQueryOrNotQuery Query -> Bool
p) [Query]
qs
    filterQueryOrNotQuery' Query -> Bool
p (Or [Query]
qs)       = [Query] -> Query
Or  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Query -> Bool) -> Query -> Query
filterQueryOrNotQuery Query -> Bool
p) [Query]
qs
    filterQueryOrNotQuery' Query -> Bool
p (Not Query
q) | Query -> Bool
p Query
q = Query -> Query
Not forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQueryOrNotQuery Query -> Bool
p Query
q
    filterQueryOrNotQuery' Query -> Bool
p Query
q = if Query -> Bool
p Query
q then Query
q else Query
Any

-- * predicates

-- | Does this simple query predicate match any part of this possibly compound query ?
matchesQuery :: (Query -> Bool) -> Query -> Bool
matchesQuery :: (Query -> Bool) -> Query -> Bool
matchesQuery Query -> Bool
p (And [Query]
qs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Query -> Bool) -> Query -> Bool
matchesQuery Query -> Bool
p) [Query]
qs
matchesQuery Query -> Bool
p (Or [Query]
qs)  = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Query -> Bool) -> Query -> Bool
matchesQuery Query -> Bool
p) [Query]
qs
matchesQuery Query -> Bool
p (Not Query
q)  = Query -> Bool
p Query
q
matchesQuery Query -> Bool
p Query
q        = Query -> Bool
p Query
q

-- | Does this query match everything ?
queryIsNull :: Query -> Bool
queryIsNull :: Query -> Bool
queryIsNull Query
Any = Bool
True
queryIsNull (And []) = Bool
True
queryIsNull (Not (Or [])) = Bool
True
queryIsNull Query
_ = Bool
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 :: Query -> Bool
queryIsDate (Date DateSpan
_) = Bool
True
queryIsDate Query
_ = Bool
False

queryIsDate2 :: Query -> Bool
queryIsDate2 :: Query -> Bool
queryIsDate2 (Date2 DateSpan
_) = Bool
True
queryIsDate2 Query
_ = Bool
False

queryIsDateOrDate2 :: Query -> Bool
queryIsDateOrDate2 :: Query -> Bool
queryIsDateOrDate2 (Date DateSpan
_) = Bool
True
queryIsDateOrDate2 (Date2 DateSpan
_) = Bool
True
queryIsDateOrDate2 Query
_ = Bool
False

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

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

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

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

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

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

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

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

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

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

-- | 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 :: Bool -> Query -> Bool
queryIsStartDateOnly Bool
_ Query
Any = Bool
False
queryIsStartDateOnly Bool
_ Query
None = Bool
False
queryIsStartDateOnly Bool
secondary (Or [Query]
ms) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Query -> Bool
queryIsStartDateOnly Bool
secondary) [Query]
ms
queryIsStartDateOnly Bool
secondary (And [Query]
ms) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Query -> Bool
queryIsStartDateOnly Bool
secondary) [Query]
ms
queryIsStartDateOnly Bool
False (Date (DateSpan (Just EFDay
_) Maybe EFDay
_)) = Bool
True
queryIsStartDateOnly Bool
True (Date2 (DateSpan (Just EFDay
_) Maybe EFDay
_)) = Bool
True
queryIsStartDateOnly Bool
_ Query
_ = Bool
False

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

(|||) :: (a->Bool) -> (a->Bool) -> (a->Bool)
a -> Bool
p ||| :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| a -> Bool
q = \a
v -> a -> Bool
p a
v Bool -> Bool -> Bool
|| a -> Bool
q a
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 :: Bool -> Query -> Maybe Day
queryStartDate Bool
secondary (Or [Query]
ms) = [Maybe Day] -> Maybe Day
earliestMaybeDate forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> Maybe Day
queryStartDate Bool
secondary) [Query]
ms
queryStartDate Bool
secondary (And [Query]
ms) = [Maybe Day] -> Maybe Day
latestMaybeDate forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> Maybe Day
queryStartDate Bool
secondary) [Query]
ms
queryStartDate Bool
False (Date (DateSpan (Just EFDay
d) Maybe EFDay
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
d
queryStartDate Bool
True (Date2 (DateSpan (Just EFDay
d) Maybe EFDay
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
d
queryStartDate Bool
_ Query
_ = forall a. Maybe a
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 :: Bool -> Query -> Maybe Day
queryEndDate Bool
secondary (Or [Query]
ms) = [Maybe Day] -> Maybe Day
latestMaybeDate' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> Maybe Day
queryEndDate Bool
secondary) [Query]
ms
queryEndDate Bool
secondary (And [Query]
ms) = [Maybe Day] -> Maybe Day
earliestMaybeDate' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> Maybe Day
queryEndDate Bool
secondary) [Query]
ms
queryEndDate Bool
False (Date (DateSpan Maybe EFDay
_ (Just EFDay
d))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
d
queryEndDate Bool
True (Date2 (DateSpan Maybe EFDay
_ (Just EFDay
d))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
d
queryEndDate Bool
_ Query
_ = forall a. Maybe a
Nothing

queryTermDateSpan :: Query -> Maybe DateSpan
queryTermDateSpan (Date DateSpan
spn) = forall a. a -> Maybe a
Just DateSpan
spn
queryTermDateSpan Query
_ = forall a. Maybe a
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 :: Bool -> Query -> DateSpan
queryDateSpan Bool
secondary (Or [Query]
qs)  = [DateSpan] -> DateSpan
spansUnion     forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> DateSpan
queryDateSpan Bool
secondary) [Query]
qs
queryDateSpan Bool
secondary (And [Query]
qs) = [DateSpan] -> DateSpan
spansIntersect forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Query -> DateSpan
queryDateSpan Bool
secondary) [Query]
qs
queryDateSpan Bool
_     (Date DateSpan
spn)  = DateSpan
spn
queryDateSpan Bool
True (Date2 DateSpan
spn)  = DateSpan
spn
queryDateSpan Bool
_ Query
_                = DateSpan
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' :: Query -> DateSpan
queryDateSpan' (Or [Query]
qs)      = [DateSpan] -> DateSpan
spansUnion     forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Query -> DateSpan
queryDateSpan' [Query]
qs
queryDateSpan' (And [Query]
qs)     = [DateSpan] -> DateSpan
spansIntersect forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Query -> DateSpan
queryDateSpan' [Query]
qs
queryDateSpan' (Date DateSpan
spn)  = DateSpan
spn
queryDateSpan' (Date2 DateSpan
spn) = DateSpan
spn
queryDateSpan' Query
_            = DateSpan
nulldatespan

-- | What is the earliest of these dates, where Nothing is earliest ?
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
minimumMay

-- | What is the latest of these dates, where Nothing is earliest ?
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
maximumMay

-- | What is the earliest of these dates, where Nothing is the latest ?
earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
minimumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Maybe a -> Bool
isJust

-- | What is the latest of these dates, where Nothing is the latest ?
latestMaybeDate' :: [Maybe Day] -> Maybe Day
latestMaybeDate' :: [Maybe Day] -> Maybe Day
latestMaybeDate' = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> Maybe a
maximumByMay forall {a}. Ord a => Maybe a -> Maybe a -> Ordering
compareNothingMax
  where
    compareNothingMax :: Maybe a -> Maybe a -> Ordering
compareNothingMax Maybe a
Nothing  Maybe a
Nothing  = Ordering
EQ
    compareNothingMax (Just a
_) Maybe a
Nothing  = Ordering
LT
    compareNothingMax Maybe a
Nothing  (Just a
_) = Ordering
GT
    compareNothingMax (Just a
a) (Just a
b) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- | The depth limit this query specifies, if it has one
queryDepth :: Query -> Maybe Int
queryDepth :: Query -> Maybe Int
queryDepth = forall a. Ord a => [a] -> Maybe a
minimumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> [Int]
queryDepth'
  where
    queryDepth' :: Query -> [Int]
queryDepth' (Depth Int
d) = [Int
d]
    queryDepth' (Or [Query]
qs)   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query -> [Int]
queryDepth' [Query]
qs
    queryDepth' (And [Query]
qs)  = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query -> [Int]
queryDepth' [Query]
qs
    queryDepth' Query
_         = []

-- | 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 :: [QueryOpt] -> Maybe (Text, Bool)
inAccount [] = forall a. Maybe a
Nothing
inAccount (QueryOptInAcctOnly Text
a:[QueryOpt]
_) = forall a. a -> Maybe a
Just (Text
a,Bool
False)
inAccount (QueryOptInAcct Text
a:[QueryOpt]
_) = forall a. a -> Maybe a
Just (Text
a,Bool
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 :: [QueryOpt] -> Maybe Query
inAccountQuery [] = forall a. Maybe a
Nothing
inAccountQuery (QueryOptInAcctOnly Text
a : [QueryOpt]
_) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
accountNameToAccountOnlyRegex Text
a
inAccountQuery (QueryOptInAcct Text
a     : [QueryOpt]
_) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
accountNameToAccountRegex Text
a

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

-- matching things with queries

matchesCommodity :: Query -> CommoditySymbol -> Bool
matchesCommodity :: Query -> Text -> Bool
matchesCommodity (Sym Regexp
r) = Regexp -> Text -> Bool
regexMatchText Regexp
r
matchesCommodity Query
_ = forall a b. a -> b -> a
const Bool
True

-- | Does the match expression match this (simple) amount ?
matchesAmount :: Query -> Amount -> Bool
matchesAmount :: Query -> Amount -> Bool
matchesAmount (Not Query
q) Amount
a = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query
q Query -> Amount -> Bool
`matchesAmount` Amount
a
matchesAmount (Query
Any) Amount
_ = Bool
True
matchesAmount (Query
None) Amount
_ = Bool
False
matchesAmount (Or [Query]
qs) Amount
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Amount -> Bool
`matchesAmount` Amount
a) [Query]
qs
matchesAmount (And [Query]
qs) Amount
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> Amount -> Bool
`matchesAmount` Amount
a) [Query]
qs
matchesAmount (Amt OrdPlus
ord Quantity
n) Amount
a = OrdPlus -> Quantity -> Amount -> Bool
compareAmount OrdPlus
ord Quantity
n Amount
a
matchesAmount (Sym Regexp
r) Amount
a = Query -> Text -> Bool
matchesCommodity (Regexp -> Query
Sym Regexp
r) (Amount -> Text
acommodity Amount
a)
matchesAmount Query
_ Amount
_ = Bool
True

-- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
compareAmount :: OrdPlus -> Quantity -> Amount -> Bool
compareAmount :: OrdPlus -> Quantity -> Amount -> Bool
compareAmount OrdPlus
ord Quantity
q Amount{aquantity :: Amount -> Quantity
aquantity=Quantity
aq} = case OrdPlus
ord of OrdPlus
Lt      -> Quantity
aq forall a. Ord a => a -> a -> Bool
<  Quantity
q
                                                       OrdPlus
LtEq    -> Quantity
aq forall a. Ord a => a -> a -> Bool
<= Quantity
q
                                                       OrdPlus
Gt      -> Quantity
aq forall a. Ord a => a -> a -> Bool
>  Quantity
q
                                                       OrdPlus
GtEq    -> Quantity
aq forall a. Ord a => a -> a -> Bool
>= Quantity
q
                                                       OrdPlus
Eq      -> Quantity
aq forall a. Eq a => a -> a -> Bool
== Quantity
q
                                                       OrdPlus
AbsLt   -> forall a. Num a => a -> a
abs Quantity
aq forall a. Ord a => a -> a -> Bool
<  forall a. Num a => a -> a
abs Quantity
q
                                                       OrdPlus
AbsLtEq -> forall a. Num a => a -> a
abs Quantity
aq forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs Quantity
q
                                                       OrdPlus
AbsGt   -> forall a. Num a => a -> a
abs Quantity
aq forall a. Ord a => a -> a -> Bool
>  forall a. Num a => a -> a
abs Quantity
q
                                                       OrdPlus
AbsGtEq -> forall a. Num a => a -> a
abs Quantity
aq forall a. Ord a => a -> a -> Bool
>= forall a. Num a => a -> a
abs Quantity
q
                                                       OrdPlus
AbsEq   -> forall a. Num a => a -> a
abs Quantity
aq forall a. Eq a => a -> a -> Bool
== forall a. Num a => a -> a
abs Quantity
q

matchesMixedAmount :: Query -> MixedAmount -> Bool
matchesMixedAmount :: Query -> MixedAmount -> Bool
matchesMixedAmount Query
q MixedAmount
ma = case MixedAmount -> [Amount]
amountsRaw MixedAmount
ma of
    [] -> Query
q Query -> Amount -> Bool
`matchesAmount` Amount
nullamt
    [Amount]
as -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query
q Query -> Amount -> Bool
`matchesAmount`) [Amount]
as

-- | Does the query match this account name ?
-- A matching in: clause is also considered a match.
matchesAccount :: Query -> AccountName -> Bool
matchesAccount :: Query -> Text -> Bool
matchesAccount (Query
None) Text
_ = Bool
False
matchesAccount (Not Query
m) Text
a = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query -> Text -> Bool
matchesAccount Query
m Text
a
matchesAccount (Or [Query]
ms) Text
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Text -> Bool
`matchesAccount` Text
a) [Query]
ms
matchesAccount (And [Query]
ms) Text
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> Text -> Bool
`matchesAccount` Text
a) [Query]
ms
matchesAccount (Acct Regexp
r) Text
a = Regexp -> Text -> Bool
regexMatchText Regexp
r Text
a
matchesAccount (Depth Int
d) Text
a = Text -> Int
accountNameLevel Text
a forall a. Ord a => a -> a -> Bool
<= Int
d
matchesAccount (Tag Regexp
_ Maybe Regexp
_) Text
_ = Bool
False
matchesAccount Query
_ Text
_ = Bool
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 :: (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags (Not Query
q  ) Text
a = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags Query
q Text
a
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags (Or  [Query]
qs ) Text
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Query
q -> (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags Query
q Text
a) [Query]
qs
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags (And [Query]
qs ) Text
a = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Query
q -> (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
atags Query
q Text
a) [Query]
qs
matchesAccountExtra Text -> Maybe AccountType
atypes Text -> [(Text, Text)]
_     (Type [AccountType]
ts) Text
a = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\AccountType
t -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountType
t AccountType -> AccountType -> Bool
`isAccountSubtypeOf`) [AccountType]
ts) forall a b. (a -> b) -> a -> b
$ Text -> Maybe AccountType
atypes Text
a
matchesAccountExtra Text -> Maybe AccountType
_      Text -> [(Text, Text)]
atags (Tag Regexp
npat Maybe Regexp
vpat) Text
a = Regexp -> Maybe Regexp -> [(Text, Text)] -> Bool
matchesTags Regexp
npat Maybe Regexp
vpat forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)]
atags Text
a
matchesAccountExtra Text -> Maybe AccountType
_      Text -> [(Text, Text)]
_     Query
q         Text
a = Query -> Text -> Bool
matchesAccount Query
q Text
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 :: Query -> Posting -> Bool
matchesPosting (Not Query
q) Posting
p = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query
q Query -> Posting -> Bool
`matchesPosting` Posting
p
matchesPosting (Query
Any) Posting
_ = Bool
True
matchesPosting (Query
None) Posting
_ = Bool
False
matchesPosting (Or [Query]
qs) Posting
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Posting -> Bool
`matchesPosting` Posting
p) [Query]
qs
matchesPosting (And [Query]
qs) Posting
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> Posting -> Bool
`matchesPosting` Posting
p) [Query]
qs
matchesPosting (Code Regexp
r) Posting
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Regexp -> Text -> Bool
regexMatchText Regexp
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tcode) forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
matchesPosting (Desc Regexp
r) Posting
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Regexp -> Text -> Bool
regexMatchText Regexp
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription) forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
matchesPosting (Acct Regexp
r) Posting
p = Posting -> Bool
matches Posting
p Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Posting -> Bool
matches (Posting -> Maybe Posting
poriginal Posting
p) where matches :: Posting -> Bool
matches = Regexp -> Text -> Bool
regexMatchText Regexp
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Text
paccount
matchesPosting (Date DateSpan
spn) Posting
p = DateSpan
spn DateSpan -> Day -> Bool
`spanContainsDate` Posting -> Day
postingDate Posting
p
matchesPosting (Date2 DateSpan
spn) Posting
p = DateSpan
spn DateSpan -> Day -> Bool
`spanContainsDate` Posting -> Day
postingDate2 Posting
p
matchesPosting (StatusQ Status
s) Posting
p = Posting -> Status
postingStatus Posting
p forall a. Eq a => a -> a -> Bool
== Status
s
matchesPosting (Real Bool
v) Posting
p = Bool
v forall a. Eq a => a -> a -> Bool
== Posting -> Bool
isReal Posting
p
matchesPosting q :: Query
q@(Depth Int
_) Posting{paccount :: Posting -> Text
paccount=Text
a} = Query
q Query -> Text -> Bool
`matchesAccount` Text
a
matchesPosting q :: Query
q@(Amt OrdPlus
_ Quantity
_) Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
as} = Query
q Query -> MixedAmount -> Bool
`matchesMixedAmount` MixedAmount
as
matchesPosting (Sym Regexp
r) Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
as} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Text -> Bool
matchesCommodity (Regexp -> Query
Sym Regexp
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Text
acommodity) forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amountsRaw MixedAmount
as
matchesPosting (Tag Regexp
n Maybe Regexp
v) Posting
p = case (Regexp -> Text
reString Regexp
n, Maybe Regexp
v) of
  (Text
"payee", Just Regexp
v') -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Regexp -> Text -> Bool
regexMatchText Regexp
v' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
transactionPayee) forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
  (Text
"note", Just Regexp
v') -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Regexp -> Text -> Bool
regexMatchText Regexp
v' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
transactionNote) forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
  (Text
_, Maybe Regexp
mv) -> Regexp -> Maybe Regexp -> [(Text, Text)] -> Bool
matchesTags Regexp
n Maybe Regexp
mv forall a b. (a -> b) -> a -> b
$ Posting -> [(Text, Text)]
postingAllTags Posting
p
matchesPosting (Type [AccountType]
_) Posting
_ = Bool
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 :: (Text -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra Text -> Maybe AccountType
atype (Not Query
q )  Posting
p = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Text -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra Text -> Maybe AccountType
atype Query
q Posting
p
matchesPostingExtra Text -> Maybe AccountType
atype (Or  [Query]
qs)  Posting
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Query
q -> (Text -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra Text -> Maybe AccountType
atype Query
q Posting
p) [Query]
qs
matchesPostingExtra Text -> Maybe AccountType
atype (And [Query]
qs)  Posting
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Query
q -> (Text -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra Text -> Maybe AccountType
atype Query
q Posting
p) [Query]
qs
matchesPostingExtra Text -> Maybe AccountType
atype (Type [AccountType]
ts) Posting
p =
  -- does posting's account's type, if we can detect it, match any of the given types ?
  (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\AccountType
t -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountType
t AccountType -> AccountType -> Bool
`isAccountSubtypeOf`) [AccountType]
ts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe AccountType
atype forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p)
  -- or, try the same test with the original (pre-aliasing/pivoting) posting's account
  Bool -> Bool -> Bool
|| (forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
      Posting
porig <- Posting -> Maybe Posting
poriginal Posting
p
      let a :: Text
a = Posting -> Text
paccount Posting
porig
      AccountType
t <- Text -> Maybe AccountType
atype Text
a
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountType
t AccountType -> AccountType -> Bool
`isAccountSubtypeOf`) [AccountType]
ts
  )
matchesPostingExtra Text -> Maybe AccountType
_ Query
q Posting
p             = Query -> Posting -> Bool
matchesPosting Query
q Posting
p

-- | Does the match expression match this transaction ?
matchesTransaction :: Query -> Transaction -> Bool
matchesTransaction :: Query -> Transaction -> Bool
matchesTransaction (Not Query
q) Transaction
t = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query
q Query -> Transaction -> Bool
`matchesTransaction` Transaction
t
matchesTransaction (Query
Any) Transaction
_ = Bool
True
matchesTransaction (Query
None) Transaction
_ = Bool
False
matchesTransaction (Or [Query]
qs) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Transaction -> Bool
`matchesTransaction` Transaction
t) [Query]
qs
matchesTransaction (And [Query]
qs) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> Transaction -> Bool
`matchesTransaction` Transaction
t) [Query]
qs
matchesTransaction (Code Regexp
r) Transaction
t = Regexp -> Text -> Bool
regexMatchText Regexp
r forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t
matchesTransaction (Desc Regexp
r) Transaction
t = Regexp -> Text -> Bool
regexMatchText Regexp
r forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t
matchesTransaction q :: Query
q@(Acct Regexp
_) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query
q Query -> Posting -> Bool
`matchesPosting`) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
matchesTransaction (Date DateSpan
spn) Transaction
t = DateSpan -> Day -> Bool
spanContainsDate DateSpan
spn forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate Transaction
t
matchesTransaction (Date2 DateSpan
spn) Transaction
t = DateSpan -> Day -> Bool
spanContainsDate DateSpan
spn forall a b. (a -> b) -> a -> b
$ Transaction -> Day
transactionDate2 Transaction
t
matchesTransaction (StatusQ Status
s) Transaction
t = Transaction -> Status
tstatus Transaction
t forall a. Eq a => a -> a -> Bool
== Status
s
matchesTransaction (Real Bool
v) Transaction
t = Bool
v forall a. Eq a => a -> a -> Bool
== Transaction -> Bool
hasRealPostings Transaction
t
matchesTransaction q :: Query
q@(Amt OrdPlus
_ Quantity
_) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query
q Query -> Posting -> Bool
`matchesPosting`) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
matchesTransaction (Depth Int
d) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Query
Depth Int
d Query -> Posting -> Bool
`matchesPosting`) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
matchesTransaction q :: Query
q@(Sym Regexp
_) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query
q Query -> Posting -> Bool
`matchesPosting`) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
matchesTransaction (Tag Regexp
n Maybe Regexp
v) Transaction
t = case (Regexp -> Text
reString Regexp
n, Maybe Regexp
v) of
  (Text
"payee", Just Regexp
v') -> Regexp -> Text -> Bool
regexMatchText Regexp
v' forall a b. (a -> b) -> a -> b
$ Transaction -> Text
transactionPayee Transaction
t
  (Text
"note", Just Regexp
v') -> Regexp -> Text -> Bool
regexMatchText Regexp
v' forall a b. (a -> b) -> a -> b
$ Transaction -> Text
transactionNote Transaction
t
  (Text
_, Maybe Regexp
v') -> Regexp -> Maybe Regexp -> [(Text, Text)] -> Bool
matchesTags Regexp
n Maybe Regexp
v' forall a b. (a -> b) -> a -> b
$ Transaction -> [(Text, Text)]
transactionAllTags Transaction
t
matchesTransaction (Type [AccountType]
_) Transaction
_ = Bool
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 :: (Text -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra Text -> Maybe AccountType
atype (Not  Query
q) Transaction
t = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Text -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra Text -> Maybe AccountType
atype Query
q Transaction
t
matchesTransactionExtra Text -> Maybe AccountType
atype (Or  [Query]
qs) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Query
q -> (Text -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra Text -> Maybe AccountType
atype Query
q Transaction
t) [Query]
qs
matchesTransactionExtra Text -> Maybe AccountType
atype (And [Query]
qs) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Query
q -> (Text -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra Text -> Maybe AccountType
atype Query
q Transaction
t) [Query]
qs
matchesTransactionExtra Text -> Maybe AccountType
atype q :: Query
q@(Type [AccountType]
_) Transaction
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra Text -> Maybe AccountType
atype Query
q) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
matchesTransactionExtra Text -> Maybe AccountType
_ Query
q Transaction
t = Query -> Transaction -> Bool
matchesTransaction Query
q Transaction
t

-- | Does the query match this transaction description ?
-- Tests desc: terms, any other terms are ignored.
matchesDescription :: Query -> Text -> Bool
matchesDescription :: Query -> Text -> Bool
matchesDescription (Not Query
q) Text
d      = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query
q Query -> Text -> Bool
`matchesDescription` Text
d
matchesDescription (Query
Any) Text
_        = Bool
True
matchesDescription (Query
None) Text
_       = Bool
False
matchesDescription (Or [Query]
qs) Text
d      = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> Text -> Bool
`matchesDescription` Text
d) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
queryIsDesc [Query]
qs
matchesDescription (And [Query]
qs) Text
d     = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> Text -> Bool
`matchesDescription` Text
d) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
queryIsDesc [Query]
qs
matchesDescription (Code Regexp
_) Text
_     = Bool
False
matchesDescription (Desc Regexp
r) Text
d     = Regexp -> Text -> Bool
regexMatchText Regexp
r Text
d
matchesDescription Query
_ Text
_            = Bool
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 :: Query -> Text -> Bool
matchesPayeeWIP = Query -> Text -> Bool
matchesDescription

-- | Does the query match the name and optionally the value of any of these tags ?
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags :: Regexp -> Maybe Regexp -> [(Text, Text)] -> Bool
matchesTags Regexp
namepat Maybe Regexp
valuepat = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Regexp -> Maybe Regexp -> (Text, Text) -> Bool
matches Regexp
namepat Maybe Regexp
valuepat)
  where
    matches :: Regexp -> Maybe Regexp -> (Text, Text) -> Bool
matches Regexp
npat Maybe Regexp
vpat (Text
n,Text
v) = Regexp -> Text -> Bool
regexMatchText Regexp
npat Text
n Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True) Regexp -> Text -> Bool
regexMatchText Maybe Regexp
vpat Text
v

-- | Does the query match this market price ?
matchesPriceDirective :: Query -> PriceDirective -> Bool
matchesPriceDirective :: Query -> PriceDirective -> Bool
matchesPriceDirective (Query
None) PriceDirective
_      = Bool
False
matchesPriceDirective (Not Query
q) PriceDirective
p     = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Query -> PriceDirective -> Bool
matchesPriceDirective Query
q PriceDirective
p
matchesPriceDirective (Or [Query]
qs) PriceDirective
p     = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Query -> PriceDirective -> Bool
`matchesPriceDirective` PriceDirective
p) [Query]
qs
matchesPriceDirective (And [Query]
qs) PriceDirective
p    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Query -> PriceDirective -> Bool
`matchesPriceDirective` PriceDirective
p) [Query]
qs
matchesPriceDirective q :: Query
q@(Amt OrdPlus
_ Quantity
_) PriceDirective
p = Query -> Amount -> Bool
matchesAmount Query
q (PriceDirective -> Amount
pdamount PriceDirective
p)
matchesPriceDirective q :: Query
q@(Sym Regexp
_) PriceDirective
p   = Query -> Text -> Bool
matchesCommodity Query
q (PriceDirective -> Text
pdcommodity PriceDirective
p)
matchesPriceDirective (Date DateSpan
spn) PriceDirective
p = DateSpan -> Day -> Bool
spanContainsDate DateSpan
spn (PriceDirective -> Day
pddate PriceDirective
p)
matchesPriceDirective Query
_ PriceDirective
_           = Bool
True


-- tests

tests_Query :: TestTree
tests_Query = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Query" [
   [Char] -> Assertion -> TestTree
testCase [Char]
"simplifyQuery" forall a b. (a -> b) -> a -> b
$ do
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a"])      forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a")
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or [Query
Any,Query
None])      forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Query
Any)
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query
Any,Query
None])     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Query
None)
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query
Any,Query
Any])      forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Query
Any)
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b",Query
Any]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b")
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query
Any,[Query] -> Query
And [DateSpan -> Query
Date (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing)]]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Query
Any)
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [DateSpan -> Query
Date (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
01 Int
01)), DateSpan -> Query
Date (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
01 Int
01) forall a. Maybe a
Nothing)])
       forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (DateSpan -> Query
Date (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
01 Int
01) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
01 Int
01)))
     (Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [[Query] -> Query
Or [],[Query] -> Query
Or [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b b"]]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b b")

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"parseQuery" forall a b. (a -> b) -> a -> b
$ do
     (Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"acct:'expenses:autres d\233penses' desc:b") forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:autres d\233penses", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"inacct:a desc:\"b b\""                       forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b b", [Text -> QueryOpt
QueryOptInAcct Text
"a"])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"inacct:a inacct:b"                           forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query
Any, [Text -> QueryOpt
QueryOptInAcct Text
"a", Text -> QueryOpt
QueryOptInAcct Text
"b"])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"desc:'x x'"                                  forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"x x", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"'a a' 'b"                                    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a a",Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"'b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
nulldate Text
"\""                                          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"\"", [])

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"parseBooleanQuery" forall a b. (a -> b) -> a -> b
$ do
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(tag:'atag=a')"     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"atag") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a"), [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(  tag:\"atag=a\"  )"     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"atag") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a"), [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(acct:'expenses:food')"     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:food", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(((acct:'expenses:food')))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:food", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"acct:'expenses:food' AND desc:'b'" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:food", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"((desc:'a') AND (desc:'b') OR (desc:'c'))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [[Query] -> Query
And [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"c"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"((desc:'a') OR (desc:'b') AND (desc:'c'))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", [Query] -> Query
And [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"c"]], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"((desc:'a') AND desc:'b' AND (desc:'c'))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"c"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(NOT (desc:'a') AND (desc:'b'))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"((desc:'a') AND (NOT desc:'b'))" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(desc:'a' AND desc:'b')" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
And [Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"(acct:'a' acct:'b')" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
" acct:'a' acct:'b'" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"b"], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"not:a" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"expenses:food OR (tag:A expenses:drink)" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ([Query] -> Query
Or [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:food", [Query] -> Query
And [Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:drink", Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"A") forall a. Maybe a
Nothing]], [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"not a" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"nota" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"nota", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseBooleanQuery Day
nulldate Text
"not (acct:a)" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", [])

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"words''" forall a b. (a -> b) -> a -> b
$ do
      ([Text] -> Text -> [Text]
words'' [] Text
"a b")                   forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"a",Text
"b"]
      ([Text] -> Text -> [Text]
words'' [] Text
"'a b'")                 forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"a b"]
      ([Text] -> Text -> [Text]
words'' [] Text
"not:a b")               forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"not:a",Text
"b"]
      ([Text] -> Text -> [Text]
words'' [] Text
"not:'a b'")             forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"not:a b"]
      ([Text] -> Text -> [Text]
words'' [] Text
"'not:a b'")             forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"not:a b"]
      ([Text] -> Text -> [Text]
words'' [Text
"desc:"] Text
"not:desc:'a b'") forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"not:desc:a b"]
      ([Text] -> Text -> [Text]
words'' [Text]
queryprefixes Text
"\"acct:expenses:autres d\233penses\"") forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"acct:expenses:autres d\233penses"]
      ([Text] -> Text -> [Text]
words'' [Text]
queryprefixes Text
"\"")              forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"\""]

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"filterQuery" forall a b. (a -> b) -> a -> b
$ do
     (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
Any       forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Query
Any
     (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth (Int -> Query
Depth Int
1) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int -> Query
Depth Int
1
     (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.Query -> Bool
queryIsDepth) ([Query] -> Query
And [[Query] -> Query
And [Status -> Query
StatusQ Status
Cleared,Int -> Query
Depth Int
1]]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Status -> Query
StatusQ Status
Cleared
     (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth ([Query] -> Query
And [DateSpan -> Query
Date DateSpan
nulldatespan, Query -> Query
Not ([Query] -> Query
Or [Query
Any, Int -> Query
Depth Int
1])]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Query
Any   -- XXX unclear

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"parseQueryTerm" forall a b. (a -> b) -> a -> b
$ do
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"a"                                forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"acct:expenses:autres d\233penses" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"expenses:autres d\233penses", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"not:desc:a b"                     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"a b", [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"status:1"                         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
Cleared, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"status:*"                         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
Cleared, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"status:!"                         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
Pending, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"status:0"                         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
Unmarked, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"status:"                          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Status -> Query
StatusQ Status
Unmarked, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"payee:x"                          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Either [Char] Query
payeeTag (forall a. a -> Maybe a
Just Text
"x")
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"note:x"                           forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Either [Char] Query
noteTag (forall a. a -> Maybe a
Just Text
"x")
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"real:1"                           forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Bool -> Query
Real Bool
True, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"date:2008"                        forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Flex forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
01 Int
01) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Flex forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01), [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"date:from 2012/5/17"              forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
05 Int
17) forall a. Maybe a
Nothing, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"date:20180101-201804"             forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2018 Int
01 Int
01) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Flex forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2018 Int
04 Int
01), [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"inacct:a"                         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Query
Any, [Text -> QueryOpt
QueryOptInAcct Text
"a"])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"tag:a"                            forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"a") forall a. Maybe a
Nothing, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"tag:a=some value"                 forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"a") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegexCI' Text
"some value"), [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"amt:<0"                           forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus -> Quantity -> Query
Amt OrdPlus
Lt Quantity
0, [])
     Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
nulldate Text
"amt:>10000.10"                    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus -> Quantity -> Query
Amt OrdPlus
AbsGt Quantity
10000.1, [])

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"parseAmountQueryTerm" forall a b. (a -> b) -> a -> b
$ do
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"<0"        forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
Lt,Quantity
0) -- special case for convenience, since AbsLt 0 would be always false
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
">0"        forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
Gt,Quantity
0) -- special case for convenience and consistency with above
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
" > - 0 "   forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
Gt,Quantity
0) -- accept whitespace around the argument parts
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
">10000.10" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
AbsGt,Quantity
10000.1)
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"=0.23"     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
AbsEq,Quantity
0.23)
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"0.23"      forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
AbsEq,Quantity
0.23)
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"<=+0.23"   forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
LtEq,Quantity
0.23)
     Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"-0.23"     forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right (OrdPlus
Eq,(-Quantity
0.23))
     forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft forall a b. (a -> b) -> a -> b
$ Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"-0,23"
     forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft forall a b. (a -> b) -> a -> b
$ Text -> Either [Char] (OrdPlus, Quantity)
parseAmountQueryTerm Text
"=.23"

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"queryStartDate" forall a b. (a -> b) -> a -> b
$ do
     let small :: Maybe Day
small = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01
         big :: Maybe Day
big   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
02
     Bool -> Query -> Maybe Day
queryStartDate Bool
False ([Query] -> Query
And [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small) forall a. Maybe a
Nothing, DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
big) forall a. Maybe a
Nothing]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
big
     Bool -> Query -> Maybe Day
queryStartDate Bool
False ([Query] -> Query
And [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small) forall a. Maybe a
Nothing, DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing])         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
small
     Bool -> Query -> Maybe Day
queryStartDate Bool
False ([Query] -> Query
Or  [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small) forall a. Maybe a
Nothing, DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
big) forall a. Maybe a
Nothing]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
small
     Bool -> Query -> Maybe Day
queryStartDate Bool
False ([Query] -> Query
Or  [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small) forall a. Maybe a
Nothing, DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing])         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. Maybe a
Nothing

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"queryEndDate" forall a b. (a -> b) -> a -> b
$ do
     let small :: Maybe Day
small = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01
         big :: Maybe Day
big   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
02
     Bool -> Query -> Maybe Day
queryEndDate Bool
False ([Query] -> Query
And [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small), DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
big)]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
small
     Bool -> Query -> Maybe Day
queryEndDate Bool
False ([Query] -> Query
And [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small), DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing])         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
small
     Bool -> Query -> Maybe Day
queryEndDate Bool
False ([Query] -> Query
Or  [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small), DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
big)]) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe Day
big
     Bool -> Query -> Maybe Day
queryEndDate Bool
False ([Query] -> Query
Or  [DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
small), DateSpan -> Query
Date forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing])         forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. Maybe a
Nothing

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"matchesAccount" forall a b. (a -> b) -> a -> b
$ do
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"b:c") Query -> Text -> Bool
`matchesAccount` Text
"a:bb:c:d"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"^a:b") Query -> Text -> Bool
`matchesAccount` Text
"c:a:b"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Int -> Query
Depth Int
2 Query -> Text -> Bool
`matchesAccount` Text
"a"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Int -> Query
Depth Int
2 Query -> Text -> Bool
`matchesAccount` Text
"a:b"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Int -> Query
Depth Int
2 Query -> Text -> Bool
`matchesAccount` Text
"a:b:c"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ DateSpan -> Query
Date DateSpan
nulldatespan Query -> Text -> Bool
`matchesAccount` Text
"a"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ DateSpan -> Query
Date2 DateSpan
nulldatespan Query -> Text -> Bool
`matchesAccount` Text
"a"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"a") forall a. Maybe a
Nothing Query -> Text -> Bool
`matchesAccount` Text
"a"

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"matchesAccountExtra" forall a b. (a -> b) -> a -> b
$ do
     let tagq :: Query
tagq = Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegexCI' Text
"type") forall a. Maybe a
Nothing
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const []) Query
tagq Text
"a"
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$       (Text -> Maybe AccountType)
-> (Text -> [(Text, Text)]) -> Query -> Text -> Bool
matchesAccountExtra (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const [(Text
"type",Text
"")]) Query
tagq Text
"a"

  ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"matchesPosting" [
     [Char] -> Assertion -> TestTree
testCase [Char]
"positive match on cleared posting status"  forall a b. (a -> b) -> a -> b
$
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Status -> Query
StatusQ Status
Cleared)  Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pstatus :: Status
pstatus=Status
Cleared}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"negative match on cleared posting status"  forall a b. (a -> b) -> a -> b
$
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Status -> Query
StatusQ Status
Cleared)  Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pstatus :: Status
pstatus=Status
Cleared}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"positive match on unmarked posting status" forall a b. (a -> b) -> a -> b
$
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Status -> Query
StatusQ Status
Unmarked) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pstatus :: Status
pstatus=Status
Unmarked}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"negative match on unmarked posting status" forall a b. (a -> b) -> a -> b
$
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Query -> Query
Not forall a b. (a -> b) -> a -> b
$ Status -> Query
StatusQ Status
Unmarked) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pstatus :: Status
pstatus=Status
Unmarked}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"positive match on true posting status acquired from transaction" forall a b. (a -> b) -> a -> b
$
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Status -> Query
StatusQ Status
Cleared) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pstatus :: Status
pstatus=Status
Unmarked,ptransaction :: Maybe Transaction
ptransaction=forall a. a -> Maybe a
Just Transaction
nulltransaction{tstatus :: Status
tstatus=Status
Cleared}}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"real:1 on real posting" forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Bool -> Query
Real Bool
True) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptype :: PostingType
ptype=PostingType
RegularPosting}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"real:1 on virtual posting fails" forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Bool -> Query
Real Bool
True) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptype :: PostingType
ptype=PostingType
VirtualPosting}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"real:1 on balanced virtual posting fails" forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Bool -> Query
Real Bool
True) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptype :: PostingType
ptype=PostingType
BalancedVirtualPosting}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"acct:" forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"'b") Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{paccount :: Text
paccount=Text
"'b"}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"tag:" forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"a") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"r$")) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo") forall a. Maybe a
Nothing) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo",Text
"")]}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo") forall a. Maybe a
Nothing) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo",Text
"baz")]}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a")) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo",Text
"bar")]}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a$")) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo",Text
"bar")]}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
" foo ") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a")) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo",Text
"bar")]}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo foo") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
" ar ba ")) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"foo foo",Text
"bar bar")]}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"a tag match on a posting also sees inherited tags" forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"txntag") forall a. Maybe a
Nothing) Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{ptransaction :: Maybe Transaction
ptransaction=forall a. a -> Maybe a
Just Transaction
nulltransaction{ttags :: [(Text, Text)]
ttags=[(Text
"txntag",Text
"")]}}
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"cur:" forall a b. (a -> b) -> a -> b
$ do
      let toSym :: Text -> Query
toSym = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. [Char] -> a
error' forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm (Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"cur:"forall a. Semigroup a => a -> a -> a
<>)
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Query
toSym Text
"$" Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1} -- becomes "^$$", ie testing for null symbol
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Text -> Query
toSym Text
"\\$") Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1} -- have to quote $ for regexpr
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Text -> Query
toSym Text
"shekels") Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount Amount
nullamt{acommodity :: Text
acommodity=Text
"shekels"}}
      HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Text -> Query
toSym Text
"shek") Query -> Posting -> Bool
`matchesPosting` Posting
nullposting{pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount Amount
nullamt{acommodity :: Text
acommodity=Text
"shekels"}}
  ]

  ,[Char] -> Assertion -> TestTree
testCase [Char]
"matchesTransaction" forall a b. (a -> b) -> a -> b
$ do
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Query
Any Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"x x") Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{tdescription :: Text
tdescription=Text
"x"}
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Query
Desc forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"x x") Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{tdescription :: Text
tdescription=Text
"x x"}
     -- see posting for more tag tests
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"foo") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"a")) Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{ttags :: [(Text, Text)]
ttags=[(Text
"foo",Text
"bar")]}
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"payee") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"payee")) Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{tdescription :: Text
tdescription=Text
"payee|note"}
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"note") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"note")) Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{tdescription :: Text
tdescription=Text
"payee|note"}
     -- a tag match on a transaction also matches posting tags
     HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"postingtag") forall a. Maybe a
Nothing) Query -> Transaction -> Bool
`matchesTransaction` Transaction
nulltransaction{tpostings :: [Posting]
tpostings=[Posting
nullposting{ptags :: [(Text, Text)]
ptags=[(Text
"postingtag",Text
"")]}]}

 ]