{-|

Options common to most hledger reports.

-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Hledger.Reports.ReportOptions (
  ReportOpts(..),
  BalanceType(..),
  AccountListMode(..),
  ValuationType(..),
  FormatStr,
  defreportopts,
  rawOptsToReportOpts,
  checkReportOpts,
  flat_,
  tree_,
  reportOptsToggleStatus,
  simplifyStatuses,
  whichDateFromOpts,
  journalSelectingAmountFromOpts,
  intervalFromRawOpts,
  forecastPeriodFromRawOpts,
  queryFromOpts,
  queryFromOptsOnly,
  queryOptsFromOpts,
  transactionDateFn,
  postingDateFn,
  reportSpan,
  reportStartDate,
  reportEndDate,
  specifiedStartEndDates,
  specifiedStartDate,
  specifiedEndDate,
  reportPeriodStart,
  reportPeriodOrJournalStart,
  reportPeriodLastDay,
  reportPeriodOrJournalLastDay,
  valuationTypeIsCost,
  valuationTypeIsDefaultValue,

  tests_ReportOptions
)
where

import Control.Applicative ((<|>))
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Data.Default (Default(..))
import Safe (lastDef, lastMay)

import System.Console.ANSI (hSupportsANSIColor)
import System.Environment (lookupEnv)
import System.IO (stdout)
import Text.Megaparsec.Custom

import Hledger.Data
import Hledger.Query
import Hledger.Utils


type FormatStr = String

-- | Which "balance" is being shown in a balance report.
data BalanceType = PeriodChange      -- ^ The change of balance in each period.
                 | CumulativeChange  -- ^ The accumulated change across multiple periods.
                 | HistoricalBalance -- ^ The historical ending balance, including the effect of
                                     --   all postings before the report period. Unless altered by,
                                     --   a query, this is what you would see on a bank statement.
  deriving (BalanceType -> BalanceType -> Bool
(BalanceType -> BalanceType -> Bool)
-> (BalanceType -> BalanceType -> Bool) -> Eq BalanceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalanceType -> BalanceType -> Bool
$c/= :: BalanceType -> BalanceType -> Bool
== :: BalanceType -> BalanceType -> Bool
$c== :: BalanceType -> BalanceType -> Bool
Eq,Int -> BalanceType -> ShowS
[BalanceType] -> ShowS
BalanceType -> String
(Int -> BalanceType -> ShowS)
-> (BalanceType -> String)
-> ([BalanceType] -> ShowS)
-> Show BalanceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceType] -> ShowS
$cshowList :: [BalanceType] -> ShowS
show :: BalanceType -> String
$cshow :: BalanceType -> String
showsPrec :: Int -> BalanceType -> ShowS
$cshowsPrec :: Int -> BalanceType -> ShowS
Show)

instance Default BalanceType where def :: BalanceType
def = BalanceType
PeriodChange

-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
data AccountListMode = ALFlat | ALTree deriving (AccountListMode -> AccountListMode -> Bool
(AccountListMode -> AccountListMode -> Bool)
-> (AccountListMode -> AccountListMode -> Bool)
-> Eq AccountListMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountListMode -> AccountListMode -> Bool
$c/= :: AccountListMode -> AccountListMode -> Bool
== :: AccountListMode -> AccountListMode -> Bool
$c== :: AccountListMode -> AccountListMode -> Bool
Eq, Int -> AccountListMode -> ShowS
[AccountListMode] -> ShowS
AccountListMode -> String
(Int -> AccountListMode -> ShowS)
-> (AccountListMode -> String)
-> ([AccountListMode] -> ShowS)
-> Show AccountListMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountListMode] -> ShowS
$cshowList :: [AccountListMode] -> ShowS
show :: AccountListMode -> String
$cshow :: AccountListMode -> String
showsPrec :: Int -> AccountListMode -> ShowS
$cshowsPrec :: Int -> AccountListMode -> ShowS
Show)

instance Default AccountListMode where def :: AccountListMode
def = AccountListMode
ALFlat

-- | Standard options for customising report filtering and output.
-- Most of these correspond to standard hledger command-line options
-- or query arguments, but not all. Some are used only by certain
-- commands, as noted below.
data ReportOpts = ReportOpts {
     -- for most reports:
     ReportOpts -> Maybe Day
today_          :: Maybe Day  -- ^ The current date. A late addition to ReportOpts.
                                   -- Optional, but when set it may affect some reports:
                                   -- Reports use it when picking a -V valuation date.
                                   -- This is not great, adds indeterminacy.
    ,ReportOpts -> Period
period_         :: Period
    ,ReportOpts -> Interval
interval_       :: Interval
    ,ReportOpts -> [Status]
statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched
    ,ReportOpts -> Maybe ValuationType
value_          :: Maybe ValuationType  -- ^ What value should amounts be converted to ?
    ,ReportOpts -> Bool
infer_value_    :: Bool      -- ^ Infer market prices from transactions ?
    ,ReportOpts -> Maybe Int
depth_          :: Maybe Int
    ,ReportOpts -> Bool
date2_          :: Bool
    ,ReportOpts -> Bool
empty_          :: Bool
    ,ReportOpts -> Bool
no_elide_       :: Bool
    ,ReportOpts -> Bool
real_           :: Bool
    ,ReportOpts -> Maybe String
format_         :: Maybe FormatStr
    ,ReportOpts -> String
query_          :: String -- ^ All query arguments space sepeareted
                               --   and quoted if needed (see 'quoteIfNeeded')
    --
    ,ReportOpts -> Bool
average_        :: Bool
    -- for posting reports (register)
    ,ReportOpts -> Bool
related_        :: Bool
    -- for account transactions reports (aregister)
    ,ReportOpts -> Bool
txn_dates_      :: Bool
    -- for balance reports (bal, bs, cf, is)
    ,ReportOpts -> BalanceType
balancetype_    :: BalanceType
    ,ReportOpts -> AccountListMode
accountlistmode_ :: AccountListMode
    ,ReportOpts -> Int
drop_           :: Int
    ,ReportOpts -> Bool
row_total_      :: Bool
    ,ReportOpts -> Bool
no_total_       :: Bool
    ,ReportOpts -> Bool
pretty_tables_  :: Bool
    ,ReportOpts -> Bool
sort_amount_    :: Bool
    ,ReportOpts -> Bool
percent_        :: Bool
    ,ReportOpts -> Bool
invert_         :: Bool  -- ^ if true, flip all amount signs in reports
    ,ReportOpts -> Maybe NormalSign
normalbalance_  :: Maybe NormalSign
      -- ^ This can be set when running balance reports on a set of accounts
      --   with the same normal balance type (eg all assets, or all incomes).
      -- - It helps --sort-amount know how to sort negative numbers
      --   (eg in the income section of an income statement)
      -- - It helps compound balance report commands (is, bs etc.) do
      --   sign normalisation, converting normally negative subreports to
      --   normally positive for a more conventional display.
    ,ReportOpts -> Bool
color_          :: Bool
      -- ^ Whether to use ANSI color codes in text output.
      --   Influenced by the --color/colour flag (cf CliOptions),
      --   whether stdout is an interactive terminal, and the value of
      --   TERM and existence of NO_COLOR environment variables.
    ,ReportOpts -> Maybe DateSpan
forecast_       :: Maybe DateSpan
    ,ReportOpts -> Bool
transpose_      :: Bool
 } deriving (Int -> ReportOpts -> ShowS
[ReportOpts] -> ShowS
ReportOpts -> String
(Int -> ReportOpts -> ShowS)
-> (ReportOpts -> String)
-> ([ReportOpts] -> ShowS)
-> Show ReportOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportOpts] -> ShowS
$cshowList :: [ReportOpts] -> ShowS
show :: ReportOpts -> String
$cshow :: ReportOpts -> String
showsPrec :: Int -> ReportOpts -> ShowS
$cshowsPrec :: Int -> ReportOpts -> ShowS
Show)

instance Default ReportOpts where def :: ReportOpts
def = ReportOpts
defreportopts

defreportopts :: ReportOpts
defreportopts :: ReportOpts
defreportopts = Maybe Day
-> Period
-> Interval
-> [Status]
-> Maybe ValuationType
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe String
-> String
-> Bool
-> Bool
-> Bool
-> BalanceType
-> AccountListMode
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe NormalSign
-> Bool
-> Maybe DateSpan
-> Bool
-> ReportOpts
ReportOpts
    Maybe Day
forall a. Default a => a
def
    Period
forall a. Default a => a
def
    Interval
forall a. Default a => a
def
    [Status]
forall a. Default a => a
def
    Maybe ValuationType
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Maybe Int
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Maybe String
forall a. Default a => a
def
    String
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    BalanceType
forall a. Default a => a
def
    AccountListMode
forall a. Default a => a
def
    Int
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Maybe NormalSign
forall a. Default a => a
def
    Bool
forall a. Default a => a
def
    Maybe DateSpan
forall a. Default a => a
def
    Bool
forall a. Default a => a
def

rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts :: RawOpts
rawopts = ReportOpts -> ReportOpts
checkReportOpts (ReportOpts -> ReportOpts) -> IO ReportOpts -> IO ReportOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  let rawopts' :: RawOpts
rawopts' = RawOpts -> RawOpts
checkRawOpts RawOpts
rawopts
  Day
d <- IO Day
getCurrentDay
  Bool
no_color <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv "NO_COLOR"
  Bool
supports_color <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
  let colorflag :: String
colorflag = String -> RawOpts -> String
stringopt "color" RawOpts
rawopts
  ReportOpts -> IO ReportOpts
forall (m :: * -> *) a. Monad m => a -> m a
return ReportOpts
defreportopts{
     today_ :: Maybe Day
today_       = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
    ,period_ :: Period
period_      = Day -> RawOpts -> Period
periodFromRawOpts Day
d RawOpts
rawopts'
    ,interval_ :: Interval
interval_    = RawOpts -> Interval
intervalFromRawOpts RawOpts
rawopts'
    ,statuses_ :: [Status]
statuses_    = RawOpts -> [Status]
statusesFromRawOpts RawOpts
rawopts'
    ,value_ :: Maybe ValuationType
value_       = RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts RawOpts
rawopts'
    ,infer_value_ :: Bool
infer_value_ = String -> RawOpts -> Bool
boolopt "infer-value" RawOpts
rawopts'
    ,depth_ :: Maybe Int
depth_       = String -> RawOpts -> Maybe Int
maybeposintopt "depth" RawOpts
rawopts'
    ,date2_ :: Bool
date2_       = String -> RawOpts -> Bool
boolopt "date2" RawOpts
rawopts'
    ,empty_ :: Bool
empty_       = String -> RawOpts -> Bool
boolopt "empty" RawOpts
rawopts'
    ,no_elide_ :: Bool
no_elide_    = String -> RawOpts -> Bool
boolopt "no-elide" RawOpts
rawopts'
    ,real_ :: Bool
real_        = String -> RawOpts -> Bool
boolopt "real" RawOpts
rawopts'
    ,format_ :: Maybe String
format_      = String -> RawOpts -> Maybe String
maybestringopt "format" RawOpts
rawopts' -- XXX move to CliOpts or move validation from Cli.CliOptions to here
    ,query_ :: String
query_       = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quoteIfNeeded ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> [String]
listofstringopt "args" RawOpts
rawopts' -- doesn't handle an arg like "" right
    ,average_ :: Bool
average_     = String -> RawOpts -> Bool
boolopt "average" RawOpts
rawopts'
    ,related_ :: Bool
related_     = String -> RawOpts -> Bool
boolopt "related" RawOpts
rawopts'
    ,txn_dates_ :: Bool
txn_dates_   = String -> RawOpts -> Bool
boolopt "txn-dates" RawOpts
rawopts'
    ,balancetype_ :: BalanceType
balancetype_ = RawOpts -> BalanceType
balancetypeopt RawOpts
rawopts'
    ,accountlistmode_ :: AccountListMode
accountlistmode_ = RawOpts -> AccountListMode
accountlistmodeopt RawOpts
rawopts'
    ,drop_ :: Int
drop_        = String -> RawOpts -> Int
posintopt "drop" RawOpts
rawopts'
    ,row_total_ :: Bool
row_total_   = String -> RawOpts -> Bool
boolopt "row-total" RawOpts
rawopts'
    ,no_total_ :: Bool
no_total_    = String -> RawOpts -> Bool
boolopt "no-total" RawOpts
rawopts'
    ,sort_amount_ :: Bool
sort_amount_ = String -> RawOpts -> Bool
boolopt "sort-amount" RawOpts
rawopts'
    ,percent_ :: Bool
percent_     = String -> RawOpts -> Bool
boolopt "percent" RawOpts
rawopts'
    ,invert_ :: Bool
invert_      = String -> RawOpts -> Bool
boolopt "invert" RawOpts
rawopts'
    ,pretty_tables_ :: Bool
pretty_tables_ = String -> RawOpts -> Bool
boolopt "pretty-tables" RawOpts
rawopts'
    ,color_ :: Bool
color_       = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not Bool
no_color
                        ,Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
colorflag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["never","no"]
                        ,String
colorflag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["always","yes"] Bool -> Bool -> Bool
|| Bool
supports_color
                        ]
    ,forecast_ :: Maybe DateSpan
forecast_    = Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
d RawOpts
rawopts'
    ,transpose_ :: Bool
transpose_   = String -> RawOpts -> Bool
boolopt "transpose" RawOpts
rawopts'
    }

-- | Do extra validation of raw option values, raising an error if there's a problem.
checkRawOpts :: RawOpts -> RawOpts
checkRawOpts :: RawOpts -> RawOpts
checkRawOpts rawopts :: RawOpts
rawopts
-- our standard behaviour is to accept conflicting options actually,
-- using the last one - more forgiving for overriding command-line aliases
--   | countopts ["change","cumulative","historical"] > 1
--     = usageError "please specify at most one of --change, --cumulative, --historical"
--   | countopts ["flat","tree"] > 1
--     = usageError "please specify at most one of --flat, --tree"
--   | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1
--     = usageError "please specify at most one of --daily, "
  | Bool
otherwise = RawOpts
rawopts
--   where
--     countopts = length . filter (`boolopt` rawopts)

-- | Do extra validation of report options, raising an error if there's a problem.
checkReportOpts :: ReportOpts -> ReportOpts
checkReportOpts :: ReportOpts -> ReportOpts
checkReportOpts ropts :: ReportOpts
ropts@ReportOpts{..} =
  (String -> ReportOpts)
-> (() -> ReportOpts) -> Either String () -> ReportOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReportOpts
forall a. String -> a
usageError (ReportOpts -> () -> ReportOpts
forall a b. a -> b -> a
const ReportOpts
ropts) (Either String () -> ReportOpts) -> Either String () -> ReportOpts
forall a b. (a -> b) -> a -> b
$ do
    case Maybe Int
depth_ of
      Just d :: Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> String -> Either String ()
forall a b. a -> Either a b
Left "--depth should have a positive number"
      _              -> () -> Either String ()
forall a b. b -> Either a b
Right ()

accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt =
  AccountListMode -> Maybe AccountListMode -> AccountListMode
forall a. a -> Maybe a -> a
fromMaybe AccountListMode
ALFlat (Maybe AccountListMode -> AccountListMode)
-> (RawOpts -> Maybe AccountListMode) -> RawOpts -> AccountListMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe AccountListMode)
-> RawOpts -> Maybe AccountListMode
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe AccountListMode
parse where
    parse :: String -> Maybe AccountListMode
parse = \case
      "tree" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALTree
      "flat" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALFlat
      _      -> Maybe AccountListMode
forall a. Maybe a
Nothing

balancetypeopt :: RawOpts -> BalanceType
balancetypeopt :: RawOpts -> BalanceType
balancetypeopt =
  BalanceType -> Maybe BalanceType -> BalanceType
forall a. a -> Maybe a -> a
fromMaybe BalanceType
PeriodChange (Maybe BalanceType -> BalanceType)
-> (RawOpts -> Maybe BalanceType) -> RawOpts -> BalanceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe BalanceType) -> RawOpts -> Maybe BalanceType
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe BalanceType
parse where
    parse :: String -> Maybe BalanceType
parse = \case
      "historical" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
HistoricalBalance
      "cumulative" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
CumulativeChange
      _            -> Maybe BalanceType
forall a. Maybe a
Nothing

-- Get the period specified by any -b/--begin, -e/--end and/or -p/--period
-- options appearing in the command line.
-- Its bounds are the rightmost begin date specified by a -b or -p, and
-- the rightmost end date specified by a -e or -p. Cf #1011.
-- Today's date is provided to help interpret any relative dates.
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts d :: Day
d rawopts :: RawOpts
rawopts =
  case (Maybe Day
mlastb, Maybe Day
mlaste) of
    (Nothing, Nothing) -> Period
PeriodAll
    (Just b :: Day
b, Nothing)  -> Day -> Period
PeriodFrom Day
b
    (Nothing, Just e :: Day
e)  -> Day -> Period
PeriodTo Day
e
    (Just b :: Day
b, Just e :: Day
e)   -> Period -> Period
simplifyPeriod (Period -> Period) -> Period -> Period
forall a b. (a -> b) -> a -> b
$
                          Day -> Day -> Period
PeriodBetween Day
b Day
e
  where
    mlastb :: Maybe Day
mlastb = case Day -> RawOpts -> [Day]
beginDatesFromRawOpts Day
d RawOpts
rawopts of
                   [] -> Maybe Day
forall a. Maybe a
Nothing
                   bs :: [Day]
bs -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
last [Day]
bs
    mlaste :: Maybe Day
mlaste = case Day -> RawOpts -> [Day]
endDatesFromRawOpts Day
d RawOpts
rawopts of
                   [] -> Maybe Day
forall a. Maybe a
Nothing
                   es :: [Day]
es -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
last [Day]
es

-- Get all begin dates specified by -b/--begin or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
beginDatesFromRawOpts d :: Day
d = ((String, String) -> Maybe Day) -> RawOpts -> [Day]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> (String, String) -> Maybe Day
begindatefromrawopt Day
d)
  where
    begindatefromrawopt :: Day -> (String, String) -> Maybe Day
begindatefromrawopt d :: Day
d (n :: String
n,v :: String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "begin" =
          (ParseErrorBundle Text CustomErr -> Maybe Day)
-> (Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day
-> Maybe Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Day
forall a. String -> a
usageError (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ "could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++" date: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) Day -> Maybe Day
forall a. a -> Maybe a
Just (Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
fixSmartDateStrEither' Day
d (String -> Text
T.pack String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
        case
          (ParseErrorBundle Text CustomErr -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> (Interval, DateSpan)
forall a. String -> a
usageError (String -> (Interval, DateSpan)) -> String -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
 -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
          Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
        of
          (_, DateSpan (Just b :: Day
b) _) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b
          _                        -> Maybe Day
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Day
forall a. Maybe a
Nothing

-- Get all end dates specified by -e/--end or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
endDatesFromRawOpts :: Day -> RawOpts -> [Day]
endDatesFromRawOpts :: Day -> RawOpts -> [Day]
endDatesFromRawOpts d :: Day
d = ((String, String) -> Maybe Day) -> RawOpts -> [Day]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> (String, String) -> Maybe Day
enddatefromrawopt Day
d)
  where
    enddatefromrawopt :: Day -> (String, String) -> Maybe Day
enddatefromrawopt d :: Day
d (n :: String
n,v :: String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "end" =
          (ParseErrorBundle Text CustomErr -> Maybe Day)
-> (Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day
-> Maybe Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Day
forall a. String -> a
usageError (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ "could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++" date: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) Day -> Maybe Day
forall a. a -> Maybe a
Just (Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
fixSmartDateStrEither' Day
d (String -> Text
T.pack String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
        case
          (ParseErrorBundle Text CustomErr -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> (Interval, DateSpan)
forall a. String -> a
usageError (String -> (Interval, DateSpan)) -> String -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
 -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
          Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
        of
          (_, DateSpan _ (Just e :: Day
e)) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
e
          _                        -> Maybe Day
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Day
forall a. Maybe a
Nothing

-- | Get the report interval, if any, specified by the last of -p/--period,
-- -D/--daily, -W/--weekly, -M/--monthly etc. options.
-- An interval from --period counts only if it is explicitly defined.
intervalFromRawOpts :: RawOpts -> Interval
intervalFromRawOpts :: RawOpts -> Interval
intervalFromRawOpts = Interval -> [Interval] -> Interval
forall a. a -> [a] -> a
lastDef Interval
NoInterval ([Interval] -> Interval)
-> (RawOpts -> [Interval]) -> RawOpts -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe Interval) -> RawOpts -> [Interval]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe Interval
forall a. (Eq a, IsString a) => (a, String) -> Maybe Interval
intervalfromrawopt
  where
    intervalfromrawopt :: (a, String) -> Maybe Interval
intervalfromrawopt (n :: a
n,v :: String
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
          (ParseErrorBundle Text CustomErr -> Maybe Interval)
-> ((Interval, DateSpan) -> Maybe Interval)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe Interval
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Interval
forall a. String -> a
usageError (String -> Maybe Interval) -> String -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e)
            (Interval, DateSpan) -> Maybe Interval
extractIntervalOrNothing (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
 -> Maybe Interval)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe Interval
forall a b. (a -> b) -> a -> b
$
            Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr
              (String -> Day
forall a. String -> a
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
              (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "daily"     = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Days 1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "weekly"    = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Weeks 1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "monthly"   = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Months 1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "quarterly" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Quarters 1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "yearly"    = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Years 1
      | Bool
otherwise = Maybe Interval
forall a. Maybe a
Nothing

-- | get period expression from --forecast option
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts d :: Day
d opts :: RawOpts
opts =
  case String -> RawOpts -> Maybe String
maybestringopt "forecast" RawOpts
opts
  of
    Nothing -> Maybe DateSpan
forall a. Maybe a
Nothing
    Just "" -> DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just DateSpan
nulldatespan
    Just str :: String
str ->
      (ParseErrorBundle Text CustomErr -> Maybe DateSpan)
-> ((Interval, DateSpan) -> Maybe DateSpan)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe DateSpan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe DateSpan
forall a. String -> a
usageError (String -> Maybe DateSpan) -> String -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ "could not parse forecast period : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just (DateSpan -> Maybe DateSpan)
-> ((Interval, DateSpan) -> DateSpan)
-> (Interval, DateSpan)
-> Maybe DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval, DateSpan) -> DateSpan
forall a b. (a, b) -> b
snd) (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
 -> Maybe DateSpan)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ 
      Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text
 -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan))
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str

-- | Extract the interval from the parsed -p/--period expression.
-- Return Nothing if an interval is not explicitly defined.
extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval
extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval
extractIntervalOrNothing (NoInterval, _) = Maybe Interval
forall a. Maybe a
Nothing
extractIntervalOrNothing (interval :: Interval
interval, _) = Interval -> Maybe Interval
forall a. a -> Maybe a
Just Interval
interval

-- | Get any statuses to be matched, as specified by -U/--unmarked,
-- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags,
-- so this returns a list of 0-2 unique statuses.
statusesFromRawOpts :: RawOpts -> [Status]
statusesFromRawOpts :: RawOpts -> [Status]
statusesFromRawOpts = [Status] -> [Status]
forall a. Ord a => [a] -> [a]
simplifyStatuses ([Status] -> [Status])
-> (RawOpts -> [Status]) -> RawOpts -> [Status]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe Status) -> RawOpts -> [Status]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe Status
forall a b. (Eq a, IsString a) => (a, b) -> Maybe Status
statusfromrawopt
  where
    statusfromrawopt :: (a, b) -> Maybe Status
statusfromrawopt (n :: a
n,_)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "unmarked"  = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Unmarked
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "pending"   = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Pending
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "cleared"   = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Cleared
      | Bool
otherwise        = Maybe Status
forall a. Maybe a
Nothing

-- | Reduce a list of statuses to just one of each status,
-- and if all statuses are present return the empty list.
simplifyStatuses :: [a] -> [a]
simplifyStatuses l :: [a]
l
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numstatuses = []
  | Bool
otherwise                = [a]
l'
  where
    l' :: [a]
l' = [a] -> [a]
forall a. Ord a => [a] -> [a]
nubSort [a]
l
    numstatuses :: Int
numstatuses = [Status] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status
forall a. Bounded a => a
minBound .. Status
forall a. Bounded a => a
maxBound :: Status]

-- | Add/remove this status from the status list. Used by hledger-ui.
reportOptsToggleStatus :: Status -> ReportOpts -> ReportOpts
reportOptsToggleStatus s :: Status
s ropts :: ReportOpts
ropts@ReportOpts{statuses_ :: ReportOpts -> [Status]
statuses_=[Status]
ss}
  | Status
s Status -> [Status] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
ss = ReportOpts
ropts{statuses_ :: [Status]
statuses_=(Status -> Bool) -> [Status] -> [Status]
forall a. (a -> Bool) -> [a] -> [a]
filter (Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
s) [Status]
ss}
  | Bool
otherwise   = ReportOpts
ropts{statuses_ :: [Status]
statuses_=[Status] -> [Status]
forall a. Ord a => [a] -> [a]
simplifyStatuses (Status
sStatus -> [Status] -> [Status]
forall a. a -> [a] -> [a]
:[Status]
ss)}

-- | Parse the type of valuation to be performed, if any, specified by
-- -B/--cost, -V, -X/--exchange, or --value flags. If there's more
-- than one of these, the rightmost flag wins.
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts = [ValuationType] -> Maybe ValuationType
forall a. [a] -> Maybe a
lastMay ([ValuationType] -> Maybe ValuationType)
-> (RawOpts -> [ValuationType]) -> RawOpts -> Maybe ValuationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe ValuationType)
-> RawOpts -> [ValuationType]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe ValuationType
forall a. (Eq a, IsString a) => (a, String) -> Maybe ValuationType
valuationfromrawopt
  where
    valuationfromrawopt :: (a, String) -> Maybe ValuationType
valuationfromrawopt (n :: a
n,v :: String
v)  -- option name, value
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "B"     = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtCost Maybe Text
forall a. Maybe a
Nothing
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "V"     = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtDefault Maybe Text
forall a. Maybe a
Nothing
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "X"     = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtDefault (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "value" = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ String -> ValuationType
valuation String
v
      | Bool
otherwise    = Maybe ValuationType
forall a. Maybe a
Nothing
    valuation :: String -> ValuationType
valuation v :: String
v
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["cost","c"]  = Maybe Text -> ValuationType
AtCost Maybe Text
mc
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["then" ,"t"] = Maybe Text -> ValuationType
AtThen  Maybe Text
mc
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["end" ,"e"]  = Maybe Text -> ValuationType
AtEnd  Maybe Text
mc
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["now" ,"n"]  = Maybe Text -> ValuationType
AtNow  Maybe Text
mc
      | Bool
otherwise =
          case String -> Maybe Day
parsedateM String
t of
            Just d :: Day
d  -> Day -> Maybe Text -> ValuationType
AtDate Day
d Maybe Text
mc
            Nothing -> String -> ValuationType
forall a. String -> a
usageError (String -> ValuationType) -> String -> ValuationType
forall a b. (a -> b) -> a -> b
$ "could not parse \""String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD"
      where
        -- parse --value's value: TYPE[,COMM]
        (t :: String
t,c' :: String
c') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==',') String
v
        mc :: Maybe Text
mc     = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 String
c' of
                   "" -> Maybe Text
forall a. Maybe a
Nothing
                   c :: String
c  -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
c

valuationTypeIsCost :: ReportOpts -> Bool
valuationTypeIsCost :: ReportOpts -> Bool
valuationTypeIsCost ropts :: ReportOpts
ropts =
  case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
    Just (AtCost _) -> Bool
True
    _               -> Bool
False

valuationTypeIsDefaultValue :: ReportOpts -> Bool
valuationTypeIsDefaultValue :: ReportOpts -> Bool
valuationTypeIsDefaultValue ropts :: ReportOpts
ropts =
  case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
    Just (AtDefault _) -> Bool
True
    _                  -> Bool
False

-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> (Transaction -> Day)
transactionDateFn :: ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts{..} = if Bool
date2_ then Transaction -> Day
transactionDate2 else Transaction -> Day
tdate

-- | Select the Posting date accessor based on --date2.
postingDateFn :: ReportOpts -> (Posting -> Day)
postingDateFn :: ReportOpts -> Posting -> Day
postingDateFn ReportOpts{..} = if Bool
date2_ then Posting -> Day
postingDate2 else Posting -> Day
postingDate

-- | Report which date we will report on based on --date2.
whichDateFromOpts :: ReportOpts -> WhichDate
whichDateFromOpts :: ReportOpts -> WhichDate
whichDateFromOpts ReportOpts{..} = if Bool
date2_ then WhichDate
SecondaryDate else WhichDate
PrimaryDate

-- | Legacy-compatible convenience aliases for accountlistmode_.
tree_ :: ReportOpts -> Bool
tree_ :: ReportOpts -> Bool
tree_ ReportOpts{accountlistmode_ :: ReportOpts -> AccountListMode
accountlistmode_ = AccountListMode
ALTree} = Bool
True
tree_ ReportOpts{accountlistmode_ :: ReportOpts -> AccountListMode
accountlistmode_ = AccountListMode
ALFlat} = Bool
False

flat_ :: ReportOpts -> Bool
flat_ :: ReportOpts -> Bool
flat_ = Bool -> Bool
not (Bool -> Bool) -> (ReportOpts -> Bool) -> ReportOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> Bool
tree_

-- depthFromOpts :: ReportOpts -> Int
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)

-- | Convert this journal's postings' amounts to cost using their
-- transaction prices, if specified by options (-B/--value=cost).
-- Maybe soon superseded by newer valuation code.
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts opts :: ReportOpts
opts =
  case ReportOpts -> Maybe ValuationType
value_ ReportOpts
opts of
    Just (AtCost _) -> Journal -> Journal
journalToCost
    _               -> Journal -> Journal
forall a. a -> a
id

-- | Convert report options and arguments to a query.
-- If there is a parsing problem, this function calls error.
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts d :: Day
d ropts :: ReportOpts
ropts = Query -> Query
simplifyQuery (Query -> Query) -> ([Query] -> Query) -> [Query] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Query] -> Query
And ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ [Query
flagsq, Query
argsq]
  where
    flagsq :: Query
flagsq = Day -> ReportOpts -> Query
queryFromOptsOnly Day
d ReportOpts
ropts
    argsq :: Query
argsq = (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst ((Query, [QueryOpt]) -> Query) -> (Query, [QueryOpt]) -> Query
forall a b. (a -> b) -> a -> b
$ (String -> (Query, [QueryOpt]))
-> ((Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt])
-> (Query, [QueryOpt])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (Query, [QueryOpt])
forall a. String -> a
error' (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a. a -> a
id (Either String (Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a b. (a -> b) -> a -> b
$ Day -> Text -> Either String (Query, [QueryOpt])
parseQuery Day
d (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ReportOpts -> String
query_ ReportOpts
ropts)  -- PARTIAL:

-- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly _d :: Day
_d ReportOpts{..} = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query]
flagsq
  where
    flagsq :: [Query]
flagsq = (Bool -> Query) -> Bool -> [Query] -> [Query]
forall a. (Bool -> a) -> Bool -> [a] -> [a]
consIf   Bool -> Query
Real  Bool
real_
           ([Query] -> [Query]) -> ([Query] -> [Query]) -> [Query] -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Query) -> Bool -> [Query] -> [Query]
forall a. (Bool -> a) -> Bool -> [a] -> [a]
consIf   Bool -> Query
Empty Bool
empty_
           ([Query] -> [Query]) -> ([Query] -> [Query]) -> [Query] -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Query) -> Maybe Int -> [Query] -> [Query]
forall a a. (a -> a) -> Maybe a -> [a] -> [a]
consJust Int -> Query
Depth Maybe Int
depth_
           ([Query] -> [Query]) -> [Query] -> [Query]
forall a b. (a -> b) -> a -> b
$   [ (if Bool
date2_ then DateSpan -> Query
Date2 else DateSpan -> Query
Date) (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Period -> DateSpan
periodAsDateSpan Period
period_
               , [Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (Status -> Query) -> [Status] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map Status -> Query
StatusQ [Status]
statuses_
               ]
    consIf :: (Bool -> a) -> Bool -> [a] -> [a]
consIf f :: Bool -> a
f b :: Bool
b = if Bool
b then (Bool -> a
f Bool
Truea -> [a] -> [a]
forall a. a -> [a] -> [a]
:) else [a] -> [a]
forall a. a -> a
id
    consJust :: (a -> a) -> Maybe a -> [a] -> [a]
consJust f :: a -> a
f = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id ((:) (a -> [a] -> [a]) -> (a -> a) -> a -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)

-- | Convert report options and arguments to query options.
-- If there is a parsing problem, this function calls error.
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d :: Day
d = (Query, [QueryOpt]) -> [QueryOpt]
forall a b. (a, b) -> b
snd ((Query, [QueryOpt]) -> [QueryOpt])
-> (ReportOpts -> (Query, [QueryOpt])) -> ReportOpts -> [QueryOpt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Query, [QueryOpt]))
-> ((Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt])
-> (Query, [QueryOpt])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (Query, [QueryOpt])
forall a. String -> a
error' (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a. a -> a
id (Either String (Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> (ReportOpts -> Either String (Query, [QueryOpt]))
-> ReportOpts
-> (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either String (Query, [QueryOpt])
parseQuery Day
d (Text -> Either String (Query, [QueryOpt]))
-> (ReportOpts -> Text)
-> ReportOpts
-> Either String (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ReportOpts -> String) -> ReportOpts -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> String
query_  -- PARTIAL:

-- Report dates.

-- | The effective report span is the start and end dates specified by
-- options or queries, or otherwise the earliest and latest transaction or
-- posting dates in the journal. If no dates are specified by options/queries
-- and the journal is empty, returns the null date span.
-- Needs IO to parse smart dates in options/queries.
reportSpan :: Journal -> ReportOpts -> IO DateSpan
reportSpan :: Journal -> ReportOpts -> IO DateSpan
reportSpan j :: Journal
j ropts :: ReportOpts
ropts = do
  (mspecifiedstartdate :: Maybe Day
mspecifiedstartdate, mspecifiedenddate :: Maybe Day
mspecifiedenddate) <-
    String -> (Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day)
forall a. Show a => String -> a -> a
dbg3 "specifieddates" ((Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day))
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day, Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts
  let
    DateSpan mjournalstartdate :: Maybe Day
mjournalstartdate mjournalenddate :: Maybe Day
mjournalenddate =
      String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 "journalspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> DateSpan
journalDateSpan Bool
False Journal
j  -- ignore secondary dates
    mstartdate :: Maybe Day
mstartdate = Maybe Day
mspecifiedstartdate Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
mjournalstartdate
    menddate :: Maybe Day
menddate   = Maybe Day
mspecifiedenddate   Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
mjournalenddate
  DateSpan -> IO DateSpan
forall (m :: * -> *) a. Monad m => a -> m a
return (DateSpan -> IO DateSpan) -> DateSpan -> IO DateSpan
forall a b. (a -> b) -> a -> b
$ String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 "reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
mstartdate Maybe Day
menddate

reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportStartDate j :: Journal
j ropts :: ReportOpts
ropts = DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day) -> IO DateSpan -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> ReportOpts -> IO DateSpan
reportSpan Journal
j ReportOpts
ropts

reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportEndDate j :: Journal
j ropts :: ReportOpts
ropts = DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day) -> IO DateSpan -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> ReportOpts -> IO DateSpan
reportSpan Journal
j ReportOpts
ropts

-- | The specified report start/end dates are the dates specified by options or queries, if any.
-- Needs IO to parse smart dates in options/queries.
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ropts :: ReportOpts
ropts = do
  Day
today <- IO Day
getCurrentDay
  let
    q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts
    mspecifiedstartdate :: Maybe Day
mspecifiedstartdate = Bool -> Query -> Maybe Day
queryStartDate Bool
False Query
q
    mspecifiedenddate :: Maybe Day
mspecifiedenddate   = Bool -> Query -> Maybe Day
queryEndDate   Bool
False Query
q
  (Maybe Day, Maybe Day) -> IO (Maybe Day, Maybe Day)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day
mspecifiedstartdate, Maybe Day
mspecifiedenddate)

specifiedStartDate :: ReportOpts -> IO (Maybe Day)
specifiedStartDate :: ReportOpts -> IO (Maybe Day)
specifiedStartDate ropts :: ReportOpts
ropts = (Maybe Day, Maybe Day) -> Maybe Day
forall a b. (a, b) -> a
fst ((Maybe Day, Maybe Day) -> Maybe Day)
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts

specifiedEndDate :: ReportOpts -> IO (Maybe Day)
specifiedEndDate :: ReportOpts -> IO (Maybe Day)
specifiedEndDate ropts :: ReportOpts
ropts = (Maybe Day, Maybe Day) -> Maybe Day
forall a b. (a, b) -> b
snd ((Maybe Day, Maybe Day) -> Maybe Day)
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts

-- Some pure alternatives to the above. XXX review/clean up

-- Get the report's start date.
-- If no report period is specified, will be Nothing.
-- Will also be Nothing if ReportOpts does not have today_ set,
-- since we need that to get the report period robustly
-- (unlike reportStartDate, which looks up the date with IO.)
reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart ropts :: ReportOpts
ropts@ReportOpts{..} = do
  Day
t <- Maybe Day
today_
  Bool -> Query -> Maybe Day
queryStartDate Bool
False (Query -> Maybe Day) -> Query -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Day -> ReportOpts -> Query
queryFromOpts Day
t ReportOpts
ropts

-- Get the report's start date, or if no report period is specified,
-- the journal's start date (the earliest posting date). If there's no
-- report period and nothing in the journal, will be Nothing.
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalStart ropts :: ReportOpts
ropts j :: Journal
j =
  ReportOpts -> Maybe Day
reportPeriodStart ReportOpts
ropts Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Journal -> Maybe Day
journalStartDate Bool
False Journal
j

-- Get the last day of the overall report period.
-- This the inclusive end date (one day before the
-- more commonly used, exclusive, report end date).
-- If no report period is specified, will be Nothing.
-- Will also be Nothing if ReportOpts does not have today_ set,
-- since we need that to get the report period robustly
-- (unlike reportEndDate, which looks up the date with IO.)
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay ropts :: ReportOpts
ropts@ReportOpts{..} = do
  Day
t <- Maybe Day
today_
  let q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
t ReportOpts
ropts
  Day
qend <- Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
q
  Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (-1) Day
qend

-- Get the last day of the overall report period, or if no report
-- period is specified, the last day of the journal (ie the latest
-- posting date). If there's no report period and nothing in the
-- journal, will be Nothing.
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts :: ReportOpts
ropts j :: Journal
j =
  ReportOpts -> Maybe Day
reportPeriodLastDay ReportOpts
ropts Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Journal -> Maybe Day
journalEndDate Bool
False Journal
j

-- tests

tests_ReportOptions :: TestTree
tests_ReportOptions = String -> [TestTree] -> TestTree
tests "ReportOptions" [
   String -> Assertion -> TestTree
test "queryFromOpts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Query
Any
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="a"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Regexp -> Query
Acct (String -> Regexp
toRegexCI' "a")
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="desc:'a a'"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Regexp -> Query
Desc (String -> Regexp
toRegexCI' "a a")
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{period_ :: Period
period_=Day -> Period
PeriodFrom (Integer -> Int -> Int -> Day
fromGregorian 2012 01 01),query_ :: String
query_="date:'to 2013'" }
         Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (DateSpan -> Query
Date (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2012 01 01) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2013 01 01))
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="date2:'in 2012'"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (DateSpan -> Query
Date2 (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2012 01 01) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2013 01 01))
       Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="'a a' 'b"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Query] -> Query
Or [Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ String -> Regexp
toRegexCI' "a a", Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ String -> Regexp
toRegexCI' "'b"]

  ,String -> Assertion -> TestTree
test "queryOptsFromOpts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
      Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="a"} [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
      Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts{period_ :: Period
period_=Day -> Period
PeriodFrom (Integer -> Int -> Int -> Day
fromGregorian 2012 01 01)
                                              ,query_ :: String
query_="date:'to 2013'"} [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
 ]