more query cleanup

This commit is contained in:
Simon Michael 2012-05-16 07:50:22 +00:00
parent e1b1b8bce8
commit 08bbb832d0

View File

@ -1,36 +1,35 @@
{-| {-|
More generic matching, done in one step, unlike FilterSpec and filterJournal*. A general query system for matching items by standard criteria, in one
Currently used only by hledger-web. step unlike FilterSpec and filterJournal*. Currently used by hledger-web.
-} -}
module Hledger.Data.Query ( module Hledger.Data.Query (
-- * Query and QueryOpt
Query(..), Query(..),
QueryOpt(..),
queryIsNull, queryIsNull,
queryIsStartDateOnly,
queryStartDate, queryStartDate,
matchesTransaction, queryIsStartDateOnly,
matchesPosting,
inAccount, inAccount,
inAccountQuery, inAccountQuery,
-- * parsing
parseQuery,
-- * matching
matchesTransaction,
matchesPosting,
-- * tests
tests_Hledger_Data_Query tests_Hledger_Data_Query
) )
where where
import Data.Either import Data.Either
import Data.List import Data.List
-- import Data.Map (findWithDefault, (!))
import Data.Maybe import Data.Maybe
-- import Data.Ord
import Data.Time.Calendar import Data.Time.Calendar
-- import Data.Time.LocalTime
-- import Data.Tree
import Safe (readDef, headDef) import Safe (readDef, headDef)
-- import System.Time (ClockTime(TOD))
import Test.HUnit import Test.HUnit
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
-- import Text.Printf
-- import qualified Data.Map as Map
import Hledger.Utils import Hledger.Utils
import Hledger.Data.Types import Hledger.Data.Types
@ -42,6 +41,7 @@ import Hledger.Data.Posting
import Hledger.Data.Transaction import Hledger.Data.Transaction
-- import Hledger.Data.TimeLog -- import Hledger.Data.TimeLog
-- | A query is a composition of search criteria, which can be used to -- | A query is a composition of search criteria, which can be used to
-- match postings, transactions, accounts and more. -- match postings, transactions, accounts and more.
data Query = Any -- ^ always match data Query = Any -- ^ always match
@ -69,6 +69,49 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo
-- | QueryOptEffectiveDate -- ^ show effective dates instead of actual dates -- | QueryOptEffectiveDate -- ^ show effective dates instead of actual dates
deriving (Show, Eq) deriving (Show, Eq)
-- | Does this query match everything ?
queryIsNull Any = True
queryIsNull (And []) = True
queryIsNull (Not (Or [])) = True
queryIsNull _ = False
-- | What start date does this query specify, if any ?
-- If the query is an OR expression, returns the earliest of the alternatives.
-- When the flag is true, look for a starting effective date instead.
queryStartDate :: Bool -> Query -> Maybe Day
queryStartDate effective (Or ms) = earliestMaybeDate $ map (queryStartDate effective) ms
queryStartDate effective (And ms) = latestMaybeDate $ map (queryStartDate effective) ms
queryStartDate False (Date (DateSpan (Just d) _)) = Just d
queryStartDate True (EDate (DateSpan (Just d) _)) = Just d
queryStartDate _ _ = Nothing
-- | 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 effective date instead.
queryIsStartDateOnly :: Bool -> Query -> Bool
queryIsStartDateOnly _ Any = False
queryIsStartDateOnly _ None = False
queryIsStartDateOnly effective (Or ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly effective (And ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True
queryIsStartDateOnly True (EDate (DateSpan (Just _) _)) = True
queryIsStartDateOnly _ _ = False
-- | What is the earliest of these dates, where Nothing is earliest ?
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = headDef Nothing . sortBy compareMaybeDates
-- | What is the latest of these dates, where Nothing is earliest ?
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = headDef Nothing . sortBy (flip compareMaybeDates)
-- | Compare two maybe dates, Nothing is earliest.
compareMaybeDates :: Maybe Day -> Maybe Day -> Ordering
compareMaybeDates Nothing Nothing = EQ
compareMaybeDates Nothing (Just _) = LT
compareMaybeDates (Just _) Nothing = GT
compareMaybeDates (Just a) (Just b) = compare a b
-- | The account we are currently focussed on, if any, and whether subaccounts are included. -- | The account we are currently focussed on, if any, and whether subaccounts are included.
-- Just looks at the first query option. -- Just looks at the first query option.
inAccount :: [QueryOpt] -> Maybe (AccountName,Bool) inAccount :: [QueryOpt] -> Maybe (AccountName,Bool)
@ -83,6 +126,12 @@ inAccountQuery [] = Nothing
inAccountQuery (QueryOptInAcctOnly a:_) = Just $ Acct $ accountNameToAccountOnlyRegex a inAccountQuery (QueryOptInAcctOnly a:_) = Just $ Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex a inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex a
-- -- | Convert a query to its inverse.
-- negateQuery :: Query -> Query
-- negateQuery = Not
-- query parsing
-- -- | A query restricting the account(s) to be shown in the sidebar, if any. -- -- | A query restricting the account(s) to be shown in the sidebar, if any.
-- -- Just looks at the first query option. -- -- Just looks at the first query option.
-- showAccountMatcher :: [QueryOpt] -> Maybe Query -- showAccountMatcher :: [QueryOpt] -> Maybe Query
@ -185,9 +234,7 @@ parseBool s = s `elem` truestrings
truestrings :: [String] truestrings :: [String]
truestrings = ["1","t","true"] truestrings = ["1","t","true"]
-- -- | Convert a query to its inverse. -- query matching
-- negateQuery :: Query -> Query
-- negateQuery = Not
-- | Does the match expression match this posting ? -- | Does the match expression match this posting ?
matchesPosting :: Query -> Posting -> Bool matchesPosting :: Query -> Posting -> Bool
@ -239,48 +286,7 @@ matchesAccount (And ms) a = all (`matchesAccount` a) ms
matchesAccount (Acct r) a = regexMatchesCI r a matchesAccount (Acct r) a = regexMatchesCI r a
matchesAccount _ _ = False matchesAccount _ _ = False
-- | What start date does this query specify, if any ? -- tests
-- If the query is an OR expression, returns the earliest of the alternatives.
-- When the flag is true, look for a starting effective date instead.
queryStartDate :: Bool -> Query -> Maybe Day
queryStartDate effective (Or ms) = earliestMaybeDate $ map (queryStartDate effective) ms
queryStartDate effective (And ms) = latestMaybeDate $ map (queryStartDate effective) ms
queryStartDate False (Date (DateSpan (Just d) _)) = Just d
queryStartDate True (EDate (DateSpan (Just d) _)) = Just d
queryStartDate _ _ = Nothing
-- | 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 effective date instead.
queryIsStartDateOnly :: Bool -> Query -> Bool
queryIsStartDateOnly _ Any = False
queryIsStartDateOnly _ None = False
queryIsStartDateOnly effective (Or ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly effective (And ms) = and $ map (queryIsStartDateOnly effective) ms
queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True
queryIsStartDateOnly True (EDate (DateSpan (Just _) _)) = True
queryIsStartDateOnly _ _ = False
-- | Does this query match everything ?
queryIsNull Any = True
queryIsNull (And []) = True
queryIsNull (Not (Or [])) = True
queryIsNull _ = False
-- | What is the earliest of these dates, where Nothing is earliest ?
earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = headDef Nothing . sortBy compareMaybeDates
-- | What is the latest of these dates, where Nothing is earliest ?
latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = headDef Nothing . sortBy (flip compareMaybeDates)
-- | Compare two maybe dates, Nothing is earliest.
compareMaybeDates :: Maybe Day -> Maybe Day -> Ordering
compareMaybeDates Nothing Nothing = EQ
compareMaybeDates Nothing (Just _) = LT
compareMaybeDates (Just _) Nothing = GT
compareMaybeDates (Just a) (Just b) = compare a b
tests_Hledger_Data_Query :: Test tests_Hledger_Data_Query :: Test
tests_Hledger_Data_Query = TestList tests_Hledger_Data_Query = TestList