1{-|
2
3Options common to most hledger reports.
4
5-}
6
7{-# LANGUAGE LambdaCase #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RecordWildCards #-}
10
11module Hledger.Reports.ReportOptions (
12  ReportOpts(..),
13  BalanceType(..),
14  AccountListMode(..),
15  ValuationType(..),
16  FormatStr,
17  defreportopts,
18  rawOptsToReportOpts,
19  checkReportOpts,
20  flat_,
21  tree_,
22  reportOptsToggleStatus,
23  simplifyStatuses,
24  whichDateFromOpts,
25  journalSelectingAmountFromOpts,
26  intervalFromRawOpts,
27  forecastPeriodFromRawOpts,
28  queryFromOpts,
29  queryFromOptsOnly,
30  queryOptsFromOpts,
31  transactionDateFn,
32  postingDateFn,
33  reportSpan,
34  reportStartDate,
35  reportEndDate,
36  specifiedStartEndDates,
37  specifiedStartDate,
38  specifiedEndDate,
39  reportPeriodStart,
40  reportPeriodOrJournalStart,
41  reportPeriodLastDay,
42  reportPeriodOrJournalLastDay,
43  valuationTypeIsCost,
44  valuationTypeIsDefaultValue,
45
46  tests_ReportOptions
47)
48where
49
50import Control.Applicative ((<|>))
51import Data.List.Extra (nubSort)
52import Data.Maybe (fromMaybe, isJust)
53import qualified Data.Text as T
54import Data.Time.Calendar (Day, addDays, fromGregorian)
55import Data.Default (Default(..))
56import Safe (lastDef, lastMay)
57
58import System.Console.ANSI (hSupportsANSIColor)
59import System.Environment (lookupEnv)
60import System.IO (stdout)
61import Text.Megaparsec.Custom
62
63import Hledger.Data
64import Hledger.Query
65import Hledger.Utils
66
67
68type FormatStr = String
69
70-- | Which "balance" is being shown in a balance report.
71data BalanceType = PeriodChange      -- ^ The change of balance in each period.
72                 | CumulativeChange  -- ^ The accumulated change across multiple periods.
73                 | HistoricalBalance -- ^ The historical ending balance, including the effect of
74                                     --   all postings before the report period. Unless altered by,
75                                     --   a query, this is what you would see on a bank statement.
76  deriving (Eq,Show)
77
78instance Default BalanceType where def = PeriodChange
79
80-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
81data AccountListMode = ALFlat | ALTree deriving (Eq, Show)
82
83instance Default AccountListMode where def = ALFlat
84
85-- | Standard options for customising report filtering and output.
86-- Most of these correspond to standard hledger command-line options
87-- or query arguments, but not all. Some are used only by certain
88-- commands, as noted below.
89data ReportOpts = ReportOpts {
90     -- for most reports:
91     today_          :: Maybe Day  -- ^ The current date. A late addition to ReportOpts.
92                                   -- Optional, but when set it may affect some reports:
93                                   -- Reports use it when picking a -V valuation date.
94                                   -- This is not great, adds indeterminacy.
95    ,period_         :: Period
96    ,interval_       :: Interval
97    ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched
98    ,value_          :: Maybe ValuationType  -- ^ What value should amounts be converted to ?
99    ,infer_value_    :: Bool      -- ^ Infer market prices from transactions ?
100    ,depth_          :: Maybe Int
101    ,date2_          :: Bool
102    ,empty_          :: Bool
103    ,no_elide_       :: Bool
104    ,real_           :: Bool
105    ,format_         :: Maybe FormatStr
106    ,query_          :: String -- ^ All query arguments space sepeareted
107                               --   and quoted if needed (see 'quoteIfNeeded')
108    --
109    ,average_        :: Bool
110    -- for posting reports (register)
111    ,related_        :: Bool
112    -- for account transactions reports (aregister)
113    ,txn_dates_      :: Bool
114    -- for balance reports (bal, bs, cf, is)
115    ,balancetype_    :: BalanceType
116    ,accountlistmode_ :: AccountListMode
117    ,drop_           :: Int
118    ,row_total_      :: Bool
119    ,no_total_       :: Bool
120    ,pretty_tables_  :: Bool
121    ,sort_amount_    :: Bool
122    ,percent_        :: Bool
123    ,invert_         :: Bool  -- ^ if true, flip all amount signs in reports
124    ,normalbalance_  :: Maybe NormalSign
125      -- ^ This can be set when running balance reports on a set of accounts
126      --   with the same normal balance type (eg all assets, or all incomes).
127      -- - It helps --sort-amount know how to sort negative numbers
128      --   (eg in the income section of an income statement)
129      -- - It helps compound balance report commands (is, bs etc.) do
130      --   sign normalisation, converting normally negative subreports to
131      --   normally positive for a more conventional display.
132    ,color_          :: Bool
133      -- ^ Whether to use ANSI color codes in text output.
134      --   Influenced by the --color/colour flag (cf CliOptions),
135      --   whether stdout is an interactive terminal, and the value of
136      --   TERM and existence of NO_COLOR environment variables.
137    ,forecast_       :: Maybe DateSpan
138    ,transpose_      :: Bool
139 } deriving (Show)
140
141instance Default ReportOpts where def = defreportopts
142
143defreportopts :: ReportOpts
144defreportopts = ReportOpts
145    def
146    def
147    def
148    def
149    def
150    def
151    def
152    def
153    def
154    def
155    def
156    def
157    def
158    def
159    def
160    def
161    def
162    def
163    def
164    def
165    def
166    def
167    def
168    def
169    def
170    def
171    def
172    def
173    def
174
175rawOptsToReportOpts :: RawOpts -> IO ReportOpts
176rawOptsToReportOpts rawopts = checkReportOpts <$> do
177  let rawopts' = checkRawOpts rawopts
178  d <- getCurrentDay
179  no_color <- isJust <$> lookupEnv "NO_COLOR"
180  supports_color <- hSupportsANSIColor stdout
181  let colorflag = stringopt "color" rawopts
182  return defreportopts{
183     today_       = Just d
184    ,period_      = periodFromRawOpts d rawopts'
185    ,interval_    = intervalFromRawOpts rawopts'
186    ,statuses_    = statusesFromRawOpts rawopts'
187    ,value_       = valuationTypeFromRawOpts rawopts'
188    ,infer_value_ = boolopt "infer-value" rawopts'
189    ,depth_       = maybeposintopt "depth" rawopts'
190    ,date2_       = boolopt "date2" rawopts'
191    ,empty_       = boolopt "empty" rawopts'
192    ,no_elide_    = boolopt "no-elide" rawopts'
193    ,real_        = boolopt "real" rawopts'
194    ,format_      = maybestringopt "format" rawopts' -- XXX move to CliOpts or move validation from Cli.CliOptions to here
195    ,query_       = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right
196    ,average_     = boolopt "average" rawopts'
197    ,related_     = boolopt "related" rawopts'
198    ,txn_dates_   = boolopt "txn-dates" rawopts'
199    ,balancetype_ = balancetypeopt rawopts'
200    ,accountlistmode_ = accountlistmodeopt rawopts'
201    ,drop_        = posintopt "drop" rawopts'
202    ,row_total_   = boolopt "row-total" rawopts'
203    ,no_total_    = boolopt "no-total" rawopts'
204    ,sort_amount_ = boolopt "sort-amount" rawopts'
205    ,percent_     = boolopt "percent" rawopts'
206    ,invert_      = boolopt "invert" rawopts'
207    ,pretty_tables_ = boolopt "pretty-tables" rawopts'
208    ,color_       = and [not no_color
209                        ,not $ colorflag `elem` ["never","no"]
210                        ,colorflag `elem` ["always","yes"] || supports_color
211                        ]
212    ,forecast_    = forecastPeriodFromRawOpts d rawopts'
213    ,transpose_   = boolopt "transpose" rawopts'
214    }
215
216-- | Do extra validation of raw option values, raising an error if there's a problem.
217checkRawOpts :: RawOpts -> RawOpts
218checkRawOpts rawopts
219-- our standard behaviour is to accept conflicting options actually,
220-- using the last one - more forgiving for overriding command-line aliases
221--   | countopts ["change","cumulative","historical"] > 1
222--     = usageError "please specify at most one of --change, --cumulative, --historical"
223--   | countopts ["flat","tree"] > 1
224--     = usageError "please specify at most one of --flat, --tree"
225--   | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1
226--     = usageError "please specify at most one of --daily, "
227  | otherwise = rawopts
228--   where
229--     countopts = length . filter (`boolopt` rawopts)
230
231-- | Do extra validation of report options, raising an error if there's a problem.
232checkReportOpts :: ReportOpts -> ReportOpts
233checkReportOpts ropts@ReportOpts{..} =
234  either usageError (const ropts) $ do
235    case depth_ of
236      Just d | d < 0 -> Left "--depth should have a positive number"
237      _              -> Right ()
238
239accountlistmodeopt :: RawOpts -> AccountListMode
240accountlistmodeopt =
241  fromMaybe ALFlat . choiceopt parse where
242    parse = \case
243      "tree" -> Just ALTree
244      "flat" -> Just ALFlat
245      _      -> Nothing
246
247balancetypeopt :: RawOpts -> BalanceType
248balancetypeopt =
249  fromMaybe PeriodChange . choiceopt parse where
250    parse = \case
251      "historical" -> Just HistoricalBalance
252      "cumulative" -> Just CumulativeChange
253      _            -> Nothing
254
255-- Get the period specified by any -b/--begin, -e/--end and/or -p/--period
256-- options appearing in the command line.
257-- Its bounds are the rightmost begin date specified by a -b or -p, and
258-- the rightmost end date specified by a -e or -p. Cf #1011.
259-- Today's date is provided to help interpret any relative dates.
260periodFromRawOpts :: Day -> RawOpts -> Period
261periodFromRawOpts d rawopts =
262  case (mlastb, mlaste) of
263    (Nothing, Nothing) -> PeriodAll
264    (Just b, Nothing)  -> PeriodFrom b
265    (Nothing, Just e)  -> PeriodTo e
266    (Just b, Just e)   -> simplifyPeriod $
267                          PeriodBetween b e
268  where
269    mlastb = case beginDatesFromRawOpts d rawopts of
270                   [] -> Nothing
271                   bs -> Just $ last bs
272    mlaste = case endDatesFromRawOpts d rawopts of
273                   [] -> Nothing
274                   es -> Just $ last es
275
276-- Get all begin dates specified by -b/--begin or -p/--period options, in order,
277-- using the given date to interpret relative date expressions.
278beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
279beginDatesFromRawOpts d = collectopts (begindatefromrawopt d)
280  where
281    begindatefromrawopt d (n,v)
282      | n == "begin" =
283          either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $
284          fixSmartDateStrEither' d (T.pack v)
285      | n == "period" =
286        case
287          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $
288          parsePeriodExpr d (stripquotes $ T.pack v)
289        of
290          (_, DateSpan (Just b) _) -> Just b
291          _                        -> Nothing
292      | otherwise = Nothing
293
294-- Get all end dates specified by -e/--end or -p/--period options, in order,
295-- using the given date to interpret relative date expressions.
296endDatesFromRawOpts :: Day -> RawOpts -> [Day]
297endDatesFromRawOpts d = collectopts (enddatefromrawopt d)
298  where
299    enddatefromrawopt d (n,v)
300      | n == "end" =
301          either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $
302          fixSmartDateStrEither' d (T.pack v)
303      | n == "period" =
304        case
305          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $
306          parsePeriodExpr d (stripquotes $ T.pack v)
307        of
308          (_, DateSpan _ (Just e)) -> Just e
309          _                        -> Nothing
310      | otherwise = Nothing
311
312-- | Get the report interval, if any, specified by the last of -p/--period,
313-- -D/--daily, -W/--weekly, -M/--monthly etc. options.
314-- An interval from --period counts only if it is explicitly defined.
315intervalFromRawOpts :: RawOpts -> Interval
316intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
317  where
318    intervalfromrawopt (n,v)
319      | n == "period" =
320          either
321            (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e)
322            extractIntervalOrNothing $
323            parsePeriodExpr
324              (error' "intervalFromRawOpts: did not expect to need today's date here")  -- PARTIAL: should not happen; we are just getting the interval, which does not use the reference date
325              (stripquotes $ T.pack v)
326      | n == "daily"     = Just $ Days 1
327      | n == "weekly"    = Just $ Weeks 1
328      | n == "monthly"   = Just $ Months 1
329      | n == "quarterly" = Just $ Quarters 1
330      | n == "yearly"    = Just $ Years 1
331      | otherwise = Nothing
332
333-- | get period expression from --forecast option
334forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
335forecastPeriodFromRawOpts d opts =
336  case maybestringopt "forecast" opts
337  of
338    Nothing -> Nothing
339    Just "" -> Just nulldatespan
340    Just str ->
341      either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $
342      parsePeriodExpr d $ stripquotes $ T.pack str
343
344-- | Extract the interval from the parsed -p/--period expression.
345-- Return Nothing if an interval is not explicitly defined.
346extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval
347extractIntervalOrNothing (NoInterval, _) = Nothing
348extractIntervalOrNothing (interval, _) = Just interval
349
350-- | Get any statuses to be matched, as specified by -U/--unmarked,
351-- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags,
352-- so this returns a list of 0-2 unique statuses.
353statusesFromRawOpts :: RawOpts -> [Status]
354statusesFromRawOpts = simplifyStatuses . collectopts statusfromrawopt
355  where
356    statusfromrawopt (n,_)
357      | n == "unmarked"  = Just Unmarked
358      | n == "pending"   = Just Pending
359      | n == "cleared"   = Just Cleared
360      | otherwise        = Nothing
361
362-- | Reduce a list of statuses to just one of each status,
363-- and if all statuses are present return the empty list.
364simplifyStatuses l
365  | length l' >= numstatuses = []
366  | otherwise                = l'
367  where
368    l' = nubSort l
369    numstatuses = length [minBound .. maxBound :: Status]
370
371-- | Add/remove this status from the status list. Used by hledger-ui.
372reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss}
373  | s `elem` ss = ropts{statuses_=filter (/= s) ss}
374  | otherwise   = ropts{statuses_=simplifyStatuses (s:ss)}
375
376-- | Parse the type of valuation to be performed, if any, specified by
377-- -B/--cost, -V, -X/--exchange, or --value flags. If there's more
378-- than one of these, the rightmost flag wins.
379valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
380valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt
381  where
382    valuationfromrawopt (n,v)  -- option name, value
383      | n == "B"     = Just $ AtCost Nothing
384      | n == "V"     = Just $ AtDefault Nothing
385      | n == "X"     = Just $ AtDefault (Just $ T.pack v)
386      | n == "value" = Just $ valuation v
387      | otherwise    = Nothing
388    valuation v
389      | t `elem` ["cost","c"]  = AtCost mc
390      | t `elem` ["then" ,"t"] = AtThen  mc
391      | t `elem` ["end" ,"e"]  = AtEnd  mc
392      | t `elem` ["now" ,"n"]  = AtNow  mc
393      | otherwise =
394          case parsedateM t of
395            Just d  -> AtDate d mc
396            Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD"
397      where
398        -- parse --value's value: TYPE[,COMM]
399        (t,c') = break (==',') v
400        mc     = case drop 1 c' of
401                   "" -> Nothing
402                   c  -> Just $ T.pack c
403
404valuationTypeIsCost :: ReportOpts -> Bool
405valuationTypeIsCost ropts =
406  case value_ ropts of
407    Just (AtCost _) -> True
408    _               -> False
409
410valuationTypeIsDefaultValue :: ReportOpts -> Bool
411valuationTypeIsDefaultValue ropts =
412  case value_ ropts of
413    Just (AtDefault _) -> True
414    _                  -> False
415
416-- | Select the Transaction date accessor based on --date2.
417transactionDateFn :: ReportOpts -> (Transaction -> Day)
418transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
419
420-- | Select the Posting date accessor based on --date2.
421postingDateFn :: ReportOpts -> (Posting -> Day)
422postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate
423
424-- | Report which date we will report on based on --date2.
425whichDateFromOpts :: ReportOpts -> WhichDate
426whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate
427
428-- | Legacy-compatible convenience aliases for accountlistmode_.
429tree_ :: ReportOpts -> Bool
430tree_ ReportOpts{accountlistmode_ = ALTree} = True
431tree_ ReportOpts{accountlistmode_ = ALFlat} = False
432
433flat_ :: ReportOpts -> Bool
434flat_ = not . tree_
435
436-- depthFromOpts :: ReportOpts -> Int
437-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
438
439-- | Convert this journal's postings' amounts to cost using their
440-- transaction prices, if specified by options (-B/--value=cost).
441-- Maybe soon superseded by newer valuation code.
442journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
443journalSelectingAmountFromOpts opts =
444  case value_ opts of
445    Just (AtCost _) -> journalToCost
446    _               -> id
447
448-- | Convert report options and arguments to a query.
449-- If there is a parsing problem, this function calls error.
450queryFromOpts :: Day -> ReportOpts -> Query
451queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq]
452  where
453    flagsq = queryFromOptsOnly d ropts
454    argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts)  -- PARTIAL:
455
456-- | Convert report options to a query, ignoring any non-flag command line arguments.
457queryFromOptsOnly :: Day -> ReportOpts -> Query
458queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
459  where
460    flagsq = consIf   Real  real_
461           . consIf   Empty empty_
462           . consJust Depth depth_
463           $   [ (if date2_ then Date2 else Date) $ periodAsDateSpan period_
464               , Or $ map StatusQ statuses_
465               ]
466    consIf f b = if b then (f True:) else id
467    consJust f = maybe id ((:) . f)
468
469-- | Convert report options and arguments to query options.
470-- If there is a parsing problem, this function calls error.
471queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
472queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_  -- PARTIAL:
473
474-- Report dates.
475
476-- | The effective report span is the start and end dates specified by
477-- options or queries, or otherwise the earliest and latest transaction or
478-- posting dates in the journal. If no dates are specified by options/queries
479-- and the journal is empty, returns the null date span.
480-- Needs IO to parse smart dates in options/queries.
481reportSpan :: Journal -> ReportOpts -> IO DateSpan
482reportSpan j ropts = do
483  (mspecifiedstartdate, mspecifiedenddate) <-
484    dbg3 "specifieddates" <$> specifiedStartEndDates ropts
485  let
486    DateSpan mjournalstartdate mjournalenddate =
487      dbg3 "journalspan" $ journalDateSpan False j  -- ignore secondary dates
488    mstartdate = mspecifiedstartdate <|> mjournalstartdate
489    menddate   = mspecifiedenddate   <|> mjournalenddate
490  return $ dbg3 "reportspan" $ DateSpan mstartdate menddate
491
492reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
493reportStartDate j ropts = spanStart <$> reportSpan j ropts
494
495reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
496reportEndDate j ropts = spanEnd <$> reportSpan j ropts
497
498-- | The specified report start/end dates are the dates specified by options or queries, if any.
499-- Needs IO to parse smart dates in options/queries.
500specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
501specifiedStartEndDates ropts = do
502  today <- getCurrentDay
503  let
504    q = queryFromOpts today ropts
505    mspecifiedstartdate = queryStartDate False q
506    mspecifiedenddate   = queryEndDate   False q
507  return (mspecifiedstartdate, mspecifiedenddate)
508
509specifiedStartDate :: ReportOpts -> IO (Maybe Day)
510specifiedStartDate ropts = fst <$> specifiedStartEndDates ropts
511
512specifiedEndDate :: ReportOpts -> IO (Maybe Day)
513specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts
514
515-- Some pure alternatives to the above. XXX review/clean up
516
517-- Get the report's start date.
518-- If no report period is specified, will be Nothing.
519-- Will also be Nothing if ReportOpts does not have today_ set,
520-- since we need that to get the report period robustly
521-- (unlike reportStartDate, which looks up the date with IO.)
522reportPeriodStart :: ReportOpts -> Maybe Day
523reportPeriodStart ropts@ReportOpts{..} = do
524  t <- today_
525  queryStartDate False $ queryFromOpts t ropts
526
527-- Get the report's start date, or if no report period is specified,
528-- the journal's start date (the earliest posting date). If there's no
529-- report period and nothing in the journal, will be Nothing.
530reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
531reportPeriodOrJournalStart ropts j =
532  reportPeriodStart ropts <|> journalStartDate False j
533
534-- Get the last day of the overall report period.
535-- This the inclusive end date (one day before the
536-- more commonly used, exclusive, report end date).
537-- If no report period is specified, will be Nothing.
538-- Will also be Nothing if ReportOpts does not have today_ set,
539-- since we need that to get the report period robustly
540-- (unlike reportEndDate, which looks up the date with IO.)
541reportPeriodLastDay :: ReportOpts -> Maybe Day
542reportPeriodLastDay ropts@ReportOpts{..} = do
543  t <- today_
544  let q = queryFromOpts t ropts
545  qend <- queryEndDate False q
546  return $ addDays (-1) qend
547
548-- Get the last day of the overall report period, or if no report
549-- period is specified, the last day of the journal (ie the latest
550-- posting date). If there's no report period and nothing in the
551-- journal, will be Nothing.
552reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
553reportPeriodOrJournalLastDay ropts j =
554  reportPeriodLastDay ropts <|> journalEndDate False j
555
556-- tests
557
558tests_ReportOptions = tests "ReportOptions" [
559   test "queryFromOpts" $ do
560       queryFromOpts nulldate defreportopts @?= Any
561       queryFromOpts nulldate defreportopts{query_="a"} @?= Acct (toRegexCI' "a")
562       queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc (toRegexCI' "a a")
563       queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" }
564         @?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
565       queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
566       queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct $ toRegexCI' "a a", Acct $ toRegexCI' "'b"]
567
568  ,test "queryOptsFromOpts" $ do
569      queryOptsFromOpts nulldate defreportopts @?= []
570      queryOptsFromOpts nulldate defreportopts{query_="a"} @?= []
571      queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01)
572                                              ,query_="date:'to 2013'"} @?= []
573 ]
574