{-|

Options common to most hledger reports.

-}

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

module Hledger.Reports.ReportOptions (
  ReportOpts(..),
  ReportSpec(..),
  ReportType(..),
  BalanceType(..),
  AccountListMode(..),
  ValuationType(..),
  defreportopts,
  rawOptsToReportOpts,
  defreportspec,
  reportOptsToSpec,
  updateReportSpec,
  updateReportSpecWith,
  rawOptsToReportSpec,
  balanceTypeOverride,
  flat_,
  tree_,
  reportOptsToggleStatus,
  simplifyStatuses,
  whichDateFromOpts,
  journalSelectingAmountFromOpts,
  intervalFromRawOpts,
  forecastPeriodFromRawOpts,
  queryFromFlags,
  transactionDateFn,
  postingDateFn,
  reportSpan,
  reportSpanBothDates,
  reportStartDate,
  reportEndDate,
  reportPeriodStart,
  reportPeriodOrJournalStart,
  reportPeriodLastDay,
  reportPeriodOrJournalLastDay,
)
where

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

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


-- | What is calculated and shown in each cell in a balance report.
data ReportType = ChangeReport       -- ^ The sum of posting amounts.
                | BudgetReport       -- ^ The sum of posting amounts and the goal.
                | ValueChangeReport  -- ^ The change of value of period-end historical values.
  deriving (ReportType -> ReportType -> Bool
(ReportType -> ReportType -> Bool)
-> (ReportType -> ReportType -> Bool) -> Eq ReportType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportType -> ReportType -> Bool
$c/= :: ReportType -> ReportType -> Bool
== :: ReportType -> ReportType -> Bool
$c== :: ReportType -> ReportType -> Bool
Eq, Int -> ReportType -> ShowS
[ReportType] -> ShowS
ReportType -> String
(Int -> ReportType -> ShowS)
-> (ReportType -> String)
-> ([ReportType] -> ShowS)
-> Show ReportType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportType] -> ShowS
$cshowList :: [ReportType] -> ShowS
show :: ReportType -> String
$cshow :: ReportType -> String
showsPrec :: Int -> ReportType -> ShowS
$cshowsPrec :: Int -> ReportType -> ShowS
Show)

instance Default ReportType where def :: ReportType
def = ReportType
ChangeReport

-- | Which "accumulation method" is being shown in a balance report.
data BalanceType = PeriodChange      -- ^ The accumulate change over a single 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 -> Period
period_         :: Period
    ,ReportOpts -> Interval
interval_       :: Interval
    ,ReportOpts -> [Status]
statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched
    ,ReportOpts -> Costing
cost_           :: Costing  -- ^ Should we convert amounts to cost, when present?
    ,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 -> StringFormat
format_         :: StringFormat
    ,ReportOpts -> [Text]
querystring_    :: [T.Text]
    --
    ,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 -> ReportType
reporttype_     :: ReportType
    ,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 = ReportOpts :: Period
-> Interval
-> [Status]
-> Costing
-> Maybe ValuationType
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Bool
-> StringFormat
-> [Text]
-> Bool
-> Bool
-> Bool
-> ReportType
-> BalanceType
-> AccountListMode
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe NormalSign
-> Bool
-> Maybe DateSpan
-> Bool
-> ReportOpts
ReportOpts
    { period_ :: Period
period_          = Period
PeriodAll
    , interval_ :: Interval
interval_        = Interval
NoInterval
    , statuses_ :: [Status]
statuses_        = []
    , cost_ :: Costing
cost_            = Costing
NoCost
    , value_ :: Maybe ValuationType
value_           = Maybe ValuationType
forall a. Maybe a
Nothing
    , infer_value_ :: Bool
infer_value_     = Bool
False
    , depth_ :: Maybe Int
depth_           = Maybe Int
forall a. Maybe a
Nothing
    , date2_ :: Bool
date2_           = Bool
False
    , empty_ :: Bool
empty_           = Bool
False
    , no_elide_ :: Bool
no_elide_        = Bool
False
    , real_ :: Bool
real_            = Bool
False
    , format_ :: StringFormat
format_          = StringFormat
forall a. Default a => a
def
    , querystring_ :: [Text]
querystring_     = []
    , average_ :: Bool
average_         = Bool
False
    , related_ :: Bool
related_         = Bool
False
    , txn_dates_ :: Bool
txn_dates_       = Bool
False
    , reporttype_ :: ReportType
reporttype_      = ReportType
forall a. Default a => a
def
    , balancetype_ :: BalanceType
balancetype_     = BalanceType
forall a. Default a => a
def
    , accountlistmode_ :: AccountListMode
accountlistmode_ = AccountListMode
ALFlat
    , drop_ :: Int
drop_            = Int
0
    , row_total_ :: Bool
row_total_       = Bool
False
    , no_total_ :: Bool
no_total_        = Bool
False
    , pretty_tables_ :: Bool
pretty_tables_   = Bool
False
    , sort_amount_ :: Bool
sort_amount_     = Bool
False
    , percent_ :: Bool
percent_         = Bool
False
    , invert_ :: Bool
invert_          = Bool
False
    , normalbalance_ :: Maybe NormalSign
normalbalance_   = Maybe NormalSign
forall a. Maybe a
Nothing
    , color_ :: Bool
color_           = Bool
False
    , forecast_ :: Maybe DateSpan
forecast_        = Maybe DateSpan
forall a. Maybe a
Nothing
    , transpose_ :: Bool
transpose_       = Bool
False
    }

rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts RawOpts
rawopts = do
    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 String
"NO_COLOR"
    Bool
supports_color <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout

    let colorflag :: String
colorflag    = String -> RawOpts -> String
stringopt String
"color" RawOpts
rawopts
        formatstring :: Maybe Text
formatstring = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RawOpts -> Maybe String
maybestringopt String
"format" RawOpts
rawopts
        querystring :: [Text]
querystring  = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> [String]
listofstringopt String
"args" RawOpts
rawopts  -- doesn't handle an arg like "" right
        (Costing
costing, Maybe ValuationType
valuation) = RawOpts -> (Costing, Maybe ValuationType)
valuationTypeFromRawOpts RawOpts
rawopts

    StringFormat
format <- case Text -> Either String StringFormat
parseStringFormat (Text -> Either String StringFormat)
-> Maybe Text -> Maybe (Either String StringFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
formatstring of
        Maybe (Either String StringFormat)
Nothing         -> StringFormat -> IO StringFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StringFormat
defaultBalanceLineFormat
        Just (Right StringFormat
x)  -> StringFormat -> IO StringFormat
forall (m :: * -> *) a. Monad m => a -> m a
return StringFormat
x
        Just (Left String
err) -> String -> IO StringFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO StringFormat) -> String -> IO StringFormat
forall a b. (a -> b) -> a -> b
$ String
"could not parse format option: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err

    ReportOpts -> IO ReportOpts
forall (m :: * -> *) a. Monad m => a -> m a
return ReportOpts
defreportopts
          {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
          ,cost_ :: Costing
cost_        = Costing
costing
          ,value_ :: Maybe ValuationType
value_       = Maybe ValuationType
valuation
          ,infer_value_ :: Bool
infer_value_ = String -> RawOpts -> Bool
boolopt String
"infer-market-price" RawOpts
rawopts
          ,depth_ :: Maybe Int
depth_       = String -> RawOpts -> Maybe Int
maybeposintopt String
"depth" RawOpts
rawopts
          ,date2_ :: Bool
date2_       = String -> RawOpts -> Bool
boolopt String
"date2" RawOpts
rawopts
          ,empty_ :: Bool
empty_       = String -> RawOpts -> Bool
boolopt String
"empty" RawOpts
rawopts
          ,no_elide_ :: Bool
no_elide_    = String -> RawOpts -> Bool
boolopt String
"no-elide" RawOpts
rawopts
          ,real_ :: Bool
real_        = String -> RawOpts -> Bool
boolopt String
"real" RawOpts
rawopts
          ,format_ :: StringFormat
format_      = StringFormat
format
          ,querystring_ :: [Text]
querystring_ = [Text]
querystring
          ,average_ :: Bool
average_     = String -> RawOpts -> Bool
boolopt String
"average" RawOpts
rawopts
          ,related_ :: Bool
related_     = String -> RawOpts -> Bool
boolopt String
"related" RawOpts
rawopts
          ,txn_dates_ :: Bool
txn_dates_   = String -> RawOpts -> Bool
boolopt String
"txn-dates" RawOpts
rawopts
          ,reporttype_ :: ReportType
reporttype_  = RawOpts -> ReportType
reporttypeopt 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 String
"drop" RawOpts
rawopts
          ,row_total_ :: Bool
row_total_   = String -> RawOpts -> Bool
boolopt String
"row-total" RawOpts
rawopts
          ,no_total_ :: Bool
no_total_    = String -> RawOpts -> Bool
boolopt String
"no-total" RawOpts
rawopts
          ,sort_amount_ :: Bool
sort_amount_ = String -> RawOpts -> Bool
boolopt String
"sort-amount" RawOpts
rawopts
          ,percent_ :: Bool
percent_     = String -> RawOpts -> Bool
boolopt String
"percent" RawOpts
rawopts
          ,invert_ :: Bool
invert_      = String -> RawOpts -> Bool
boolopt String
"invert" RawOpts
rawopts
          ,pretty_tables_ :: Bool
pretty_tables_ = String -> RawOpts -> Bool
boolopt String
"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` [String
"never",String
"no"]
                              ,String
colorflag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"always",String
"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 String
"transpose" RawOpts
rawopts
          }

-- | The result of successfully parsing a ReportOpts on a particular
-- Day. Any ambiguous dates are completed and Queries are parsed,
-- ensuring that there are no regular expression errors. Values here
-- should be used in preference to re-deriving them from ReportOpts.
-- If you change the query_ in ReportOpts, you should call
-- `reportOptsToSpec` to regenerate the ReportSpec with the new
-- Query.
data ReportSpec = ReportSpec
  { ReportSpec -> ReportOpts
rsOpts      :: ReportOpts  -- ^ The underlying ReportOpts used to generate this ReportSpec
  , ReportSpec -> Day
rsToday     :: Day         -- ^ The Day this ReportSpec is generated for
  , ReportSpec -> Query
rsQuery     :: Query       -- ^ The generated Query for the given day
  , ReportSpec -> [QueryOpt]
rsQueryOpts :: [QueryOpt]  -- ^ A list of QueryOpts for the given day
  } deriving (Int -> ReportSpec -> ShowS
[ReportSpec] -> ShowS
ReportSpec -> String
(Int -> ReportSpec -> ShowS)
-> (ReportSpec -> String)
-> ([ReportSpec] -> ShowS)
-> Show ReportSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportSpec] -> ShowS
$cshowList :: [ReportSpec] -> ShowS
show :: ReportSpec -> String
$cshow :: ReportSpec -> String
showsPrec :: Int -> ReportSpec -> ShowS
$cshowsPrec :: Int -> ReportSpec -> ShowS
Show)

instance Default ReportSpec where def :: ReportSpec
def = ReportSpec
defreportspec

defreportspec :: ReportSpec
defreportspec :: ReportSpec
defreportspec = ReportSpec :: ReportOpts -> Day -> Query -> [QueryOpt] -> ReportSpec
ReportSpec
    { rsOpts :: ReportOpts
rsOpts      = ReportOpts
forall a. Default a => a
def
    , rsToday :: Day
rsToday     = Day
nulldate
    , rsQuery :: Query
rsQuery     = Query
Any
    , rsQueryOpts :: [QueryOpt]
rsQueryOpts = []
    }

-- | Generate a ReportSpec from a set of ReportOpts on a given day.
reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec Day
day ReportOpts
ropts = do
    (Query
argsquery, [QueryOpt]
queryopts) <- Day -> [Text] -> Either String (Query, [QueryOpt])
parseQueryList Day
day ([Text] -> Either String (Query, [QueryOpt]))
-> [Text] -> Either String (Query, [QueryOpt])
forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Text]
querystring_ ReportOpts
ropts
    ReportSpec -> Either String ReportSpec
forall (m :: * -> *) a. Monad m => a -> m a
return ReportSpec :: ReportOpts -> Day -> Query -> [QueryOpt] -> ReportSpec
ReportSpec
      { rsOpts :: ReportOpts
rsOpts = ReportOpts
ropts
      , rsToday :: Day
rsToday = Day
day
      , rsQuery :: Query
rsQuery = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags ReportOpts
ropts, Query
argsquery]
      , rsQueryOpts :: [QueryOpt]
rsQueryOpts = [QueryOpt]
queryopts
      }

-- | Update the ReportOpts and the fields derived from it in a ReportSpec,
-- or return an error message if there is a problem such as missing or 
-- unparseable options data. This is the safe way to change a ReportSpec, 
-- ensuring that all fields (rsQuery, rsOpts, querystring_, etc.) are in sync.
updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec ReportOpts
ropts ReportSpec
rspec = Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec (ReportSpec -> Day
rsToday ReportSpec
rspec) ReportOpts
ropts

-- | Like updateReportSpec, but takes a ReportOpts-modifying function.
updateReportSpecWith :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec
updateReportSpecWith :: (ReportOpts -> ReportOpts)
-> ReportSpec -> Either String ReportSpec
updateReportSpecWith ReportOpts -> ReportOpts
f ReportSpec
rspec = Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec (ReportSpec -> Day
rsToday ReportSpec
rspec) (ReportOpts -> Either String ReportSpec)
-> (ReportOpts -> ReportOpts)
-> ReportOpts
-> Either String ReportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> ReportOpts
f (ReportOpts -> Either String ReportSpec)
-> ReportOpts -> Either String ReportSpec
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
rsOpts ReportSpec
rspec

-- | Generate a ReportSpec from RawOpts and the current date.
rawOptsToReportSpec :: RawOpts -> IO ReportSpec
rawOptsToReportSpec :: RawOpts -> IO ReportSpec
rawOptsToReportSpec RawOpts
rawopts = do
    Day
d <- IO Day
getCurrentDay
    ReportOpts
ropts <- RawOpts -> IO ReportOpts
rawOptsToReportOpts RawOpts
rawopts
    (String -> IO ReportSpec)
-> (ReportSpec -> IO ReportSpec)
-> Either String ReportSpec
-> IO ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO ReportSpec
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ReportSpec -> IO ReportSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ReportSpec -> IO ReportSpec)
-> Either String ReportSpec -> IO ReportSpec
forall a b. (a -> b) -> a -> b
$ Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec Day
d ReportOpts
ropts

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
      String
"tree" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALTree
      String
"flat" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALFlat
      String
_      -> Maybe AccountListMode
forall a. Maybe a
Nothing

reporttypeopt :: RawOpts -> ReportType
reporttypeopt :: RawOpts -> ReportType
reporttypeopt =
  ReportType -> Maybe ReportType -> ReportType
forall a. a -> Maybe a -> a
fromMaybe ReportType
ChangeReport (Maybe ReportType -> ReportType)
-> (RawOpts -> Maybe ReportType) -> RawOpts -> ReportType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe ReportType) -> RawOpts -> Maybe ReportType
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe ReportType
parse where
    parse :: String -> Maybe ReportType
parse = \case
      String
"sum"         -> ReportType -> Maybe ReportType
forall a. a -> Maybe a
Just ReportType
ChangeReport
      String
"valuechange" -> ReportType -> Maybe ReportType
forall a. a -> Maybe a
Just ReportType
ValueChangeReport
      String
"budget"      -> ReportType -> Maybe ReportType
forall a. a -> Maybe a
Just ReportType
BudgetReport
      String
_             -> Maybe ReportType
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
. RawOpts -> Maybe BalanceType
balanceTypeOverride

balanceTypeOverride :: RawOpts -> Maybe BalanceType
balanceTypeOverride :: RawOpts -> Maybe BalanceType
balanceTypeOverride RawOpts
rawopts = (String -> Maybe BalanceType) -> RawOpts -> Maybe BalanceType
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe BalanceType
parse RawOpts
rawopts Maybe BalanceType -> Maybe BalanceType -> Maybe BalanceType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe BalanceType
reportbal
  where
    parse :: String -> Maybe BalanceType
parse = \case
      String
"historical" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
HistoricalBalance
      String
"cumulative" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
CumulativeChange
      String
"change"     -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
PeriodChange
      String
_            -> Maybe BalanceType
forall a. Maybe a
Nothing
    reportbal :: Maybe BalanceType
reportbal = case RawOpts -> ReportType
reporttypeopt RawOpts
rawopts of
      ReportType
ValueChangeReport -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
PeriodChange
      ReportType
_                 -> 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 Day
d RawOpts
rawopts =
  case (Maybe Day
mlastb, Maybe Day
mlaste) of
    (Maybe Day
Nothing, Maybe Day
Nothing) -> Period
PeriodAll
    (Just Day
b, Maybe Day
Nothing)  -> Day -> Period
PeriodFrom Day
b
    (Maybe Day
Nothing, Just Day
e)  -> Day -> Period
PeriodTo Day
e
    (Just Day
b, Just 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
                   [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
                   [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 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 Day
d (String
n,String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 (\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
$ String
"could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" 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
== String
"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 (\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
$ String
"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
          (Interval
_, DateSpan (Just Day
b) Maybe Day
_) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b
          (Interval, DateSpan)
_                        -> 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 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 Day
d (String
n,String
v)
      | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 (\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
$ String
"could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" 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
== String
"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 (\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
$ String
"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
          (Interval
_, DateSpan Maybe Day
_ (Just Day
e)) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
e
          (Interval, DateSpan)
_                        -> 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 (a
n,String
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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
            (\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
$ String
"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' String
"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
== a
"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 Int
1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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 Int
1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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 Int
1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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 Int
1
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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 Int
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 Day
d RawOpts
opts =
  case String -> RawOpts -> Maybe String
maybestringopt String
"forecast" RawOpts
opts
  of
    Maybe String
Nothing -> Maybe DateSpan
forall a. Maybe a
Nothing
    Just String
"" -> DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just DateSpan
nulldatespan
    Just 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 (\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
$ String
"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 (Interval
NoInterval, DateSpan
_) = Maybe Interval
forall a. Maybe a
Nothing
extractIntervalOrNothing (Interval
interval, DateSpan
_) = 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 (a
n,b
_)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"unmarked"  = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Unmarked
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"pending"   = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Pending
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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 [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 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 and costing to be performed, if any,
-- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is
-- allowed to combine -B/--cost with any other valuation type. If
-- there's more than one valuation type, the rightmost flag wins.
valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType)
valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType)
valuationTypeFromRawOpts RawOpts
rawopts = (Costing
costing, Maybe ValuationType
valuation)
  where
    costing :: Costing
costing   = if (((Costing, Maybe ValuationType) -> Bool)
-> [(Costing, Maybe ValuationType)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Costing
CostCosting -> Costing -> Bool
forall a. Eq a => a -> a -> Bool
==) (Costing -> Bool)
-> ((Costing, Maybe ValuationType) -> Costing)
-> (Costing, Maybe ValuationType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Costing, Maybe ValuationType) -> Costing
forall a b. (a, b) -> a
fst) [(Costing, Maybe ValuationType)]
valuationopts) then Costing
Cost else Costing
NoCost
    valuation :: Maybe ValuationType
valuation = case RawOpts -> ReportType
reporttypeopt RawOpts
rawopts of
        ReportType
ValueChangeReport -> case Maybe ValuationType
directval of
            Maybe ValuationType
Nothing        -> 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
AtEnd Maybe Text
forall a. Maybe a
Nothing  -- If no valuation requested for valuechange, use AtEnd
            Just (AtEnd Maybe Text
_) -> Maybe ValuationType
directval             -- If AtEnd valuation requested, use it
            Just ValuationType
_         -> String -> Maybe ValuationType
forall a. String -> a
usageError String
"--valuechange only produces sensible results with --value=end"
        ReportType
_                  -> Maybe ValuationType
directval             -- Otherwise, use requested valuation
      where directval :: Maybe ValuationType
directval = [ValuationType] -> Maybe ValuationType
forall a. [a] -> Maybe a
lastMay ([ValuationType] -> Maybe ValuationType)
-> [ValuationType] -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ ((Costing, Maybe ValuationType) -> Maybe ValuationType)
-> [(Costing, Maybe ValuationType)] -> [ValuationType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Costing, Maybe ValuationType) -> Maybe ValuationType
forall a b. (a, b) -> b
snd [(Costing, Maybe ValuationType)]
valuationopts

    valuationopts :: [(Costing, Maybe ValuationType)]
valuationopts = ((String, String) -> Maybe (Costing, Maybe ValuationType))
-> RawOpts -> [(Costing, Maybe ValuationType)]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe (Costing, Maybe ValuationType)
forall a.
(Eq a, IsString a) =>
(a, String) -> Maybe (Costing, Maybe ValuationType)
valuationfromrawopt RawOpts
rawopts
    valuationfromrawopt :: (a, String) -> Maybe (Costing, Maybe ValuationType)
valuationfromrawopt (a
n,String
v)  -- option name, value
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"B"     = (Costing, Maybe ValuationType)
-> Maybe (Costing, Maybe ValuationType)
forall a. a -> Maybe a
Just (Costing
Cost,   Maybe ValuationType
forall a. Maybe a
Nothing)  -- keep supporting --value=cost for now
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"V"     = (Costing, Maybe ValuationType)
-> Maybe (Costing, Maybe ValuationType)
forall a. a -> Maybe a
Just (Costing
NoCost, 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
AtEnd Maybe Text
forall a. Maybe a
Nothing)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"X"     = (Costing, Maybe ValuationType)
-> Maybe (Costing, Maybe ValuationType)
forall a. a -> Maybe a
Just (Costing
NoCost, 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
AtEnd (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
== a
"value" = (Costing, Maybe ValuationType)
-> Maybe (Costing, Maybe ValuationType)
forall a. a -> Maybe a
Just ((Costing, Maybe ValuationType)
 -> Maybe (Costing, Maybe ValuationType))
-> (Costing, Maybe ValuationType)
-> Maybe (Costing, Maybe ValuationType)
forall a b. (a -> b) -> a -> b
$ String -> (Costing, Maybe ValuationType)
valueopt String
v
      | Bool
otherwise    = Maybe (Costing, Maybe ValuationType)
forall a. Maybe a
Nothing
    valueopt :: String -> (Costing, Maybe ValuationType)
valueopt String
v
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"cost",String
"c"]  = (Costing
Cost,   Maybe Text -> ValuationType
AtEnd (Maybe Text -> ValuationType)
-> (Text -> Maybe Text) -> Text -> ValuationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> ValuationType) -> Maybe Text -> Maybe ValuationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mc)  -- keep supporting --value=cost,COMM for now
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"then" ,String
"t"] = (Costing
NoCost, 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
AtThen Maybe Text
mc)
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"end" ,String
"e"]  = (Costing
NoCost, 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
AtEnd  Maybe Text
mc)
      | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"now" ,String
"n"]  = (Costing
NoCost, 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
AtNow  Maybe Text
mc)
      | Bool
otherwise = case String -> Maybe Day
parsedateM String
t of
            Just Day
d  -> (Costing
NoCost, ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Day -> Maybe Text -> ValuationType
AtDate Day
d Maybe Text
mc)
            Maybe Day
Nothing -> String -> (Costing, Maybe ValuationType)
forall a. String -> a
usageError (String -> (Costing, Maybe ValuationType))
-> String -> (Costing, Maybe ValuationType)
forall a b. (a -> b) -> a -> b
$ String
"could not parse \""String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD"
      where
        -- parse --value's value: TYPE[,COMM]
        (String
t,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
==Char
',') String
v
        mc :: Maybe Text
mc     = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
c' of
                   String
"" -> Maybe Text
forall a. Maybe a
Nothing
                   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

-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> (Transaction -> Day)
transactionDateFn :: ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
..} = 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{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
..} = 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{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
..} = 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/--cost).
-- Maybe soon superseded by newer valuation code.
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts ReportOpts
opts = case ReportOpts -> Costing
cost_ ReportOpts
opts of
    Costing
Cost   -> Journal -> Journal
journalToCost
    Costing
NoCost -> Journal -> Journal
forall a. a -> a
id

-- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromFlags :: ReportOpts -> Query
queryFromFlags :: ReportOpts -> Query
queryFromFlags ReportOpts{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
..} = 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
. (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 Bool -> a
f 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 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)

-- 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.
-- The boolean argument flags whether primary and secondary dates are considered
-- equivalently.
reportSpan :: Journal -> ReportSpec -> DateSpan
reportSpan :: Journal -> ReportSpec -> DateSpan
reportSpan = Bool -> Journal -> ReportSpec -> DateSpan
reportSpanHelper Bool
False

-- | Like reportSpan, but uses both primary and secondary dates when calculating
-- the span.
reportSpanBothDates :: Journal -> ReportSpec -> DateSpan
reportSpanBothDates :: Journal -> ReportSpec -> DateSpan
reportSpanBothDates = Bool -> Journal -> ReportSpec -> DateSpan
reportSpanHelper Bool
True

-- | A helper for reportSpan, which takes a Bool indicating whether to use both
-- primary and secondary dates.
reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan
reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan
reportSpanHelper Bool
bothdates Journal
j ReportSpec{rsQuery :: ReportSpec -> Query
rsQuery=Query
query, rsOpts :: ReportSpec -> ReportOpts
rsOpts=ReportOpts
ropts} = DateSpan
reportspan
  where
    -- The date span specified by -b/-e/-p options and query args if any.
    requestedspan :: DateSpan
requestedspan  = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"requestedspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ if Bool
bothdates then Query -> DateSpan
queryDateSpan' Query
query else Bool -> Query -> DateSpan
queryDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) Query
query
    -- If we are requesting period-end valuation, the journal date span should
    -- include price directives after the last transaction
    journalspan :: DateSpan
journalspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"journalspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ if Bool
bothdates then Journal -> DateSpan
journalDateSpanBothDates Journal
j else Bool -> Journal -> DateSpan
journalDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) Journal
j
    pricespan :: DateSpan
pricespan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"pricespan" (DateSpan -> DateSpan)
-> (Maybe Day -> DateSpan) -> Maybe Day -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> DateSpan) -> Maybe Day -> DateSpan
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
        Just (AtEnd Maybe Text
_) -> (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Day -> Day
addDays Integer
1) (Maybe Day -> Maybe Day)
-> ([PriceDirective] -> Maybe Day) -> [PriceDirective] -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
maximumMay ([Day] -> Maybe Day)
-> ([PriceDirective] -> [Day]) -> [PriceDirective] -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PriceDirective -> Day) -> [PriceDirective] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> Day
pddate ([PriceDirective] -> Maybe Day) -> [PriceDirective] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
        Maybe ValuationType
_              -> Maybe Day
forall a. Maybe a
Nothing
    -- If the requested span is open-ended, close it using the journal's start and end dates.
    -- This can still be the null (open) span if the journal is empty.
    requestedspan' :: DateSpan
requestedspan' = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"requestedspan'" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
requestedspan DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` (DateSpan
journalspan DateSpan -> DateSpan -> DateSpan
`spanUnion` DateSpan
pricespan)
    -- The list of interval spans enclosing the requested span.
    -- This list can be empty if the journal was empty,
    -- or if hledger-ui has added its special date:-tomorrow to the query
    -- and all txns are in the future.
    intervalspans :: [DateSpan]
intervalspans  = String -> [DateSpan] -> [DateSpan]
forall a. Show a => String -> a -> a
dbg3 String
"intervalspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan (ReportOpts -> Interval
interval_ ReportOpts
ropts) DateSpan
requestedspan'
    -- The requested span enlarged to enclose a whole number of intervals.
    -- This can be the null span if there were no intervals.
    reportspan :: DateSpan
reportspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 String
"reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
headMay [DateSpan]
intervalspans)
                                              (DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
lastMay [DateSpan]
intervalspans)

reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate Journal
j = DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day)
-> (ReportSpec -> DateSpan) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> DateSpan
reportSpan Journal
j

reportEndDate :: Journal -> ReportSpec -> Maybe Day
reportEndDate :: Journal -> ReportSpec -> Maybe Day
reportEndDate Journal
j = DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day)
-> (ReportSpec -> DateSpan) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> DateSpan
reportSpan Journal
j

-- 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.
reportPeriodStart :: ReportSpec -> Maybe Day
reportPeriodStart :: ReportSpec -> Maybe Day
reportPeriodStart = Bool -> Query -> Maybe Day
queryStartDate Bool
False (Query -> Maybe Day)
-> (ReportSpec -> Query) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> Query
rsQuery

-- 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 :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart ReportSpec
rspec Journal
j =
  ReportSpec -> Maybe Day
reportPeriodStart ReportSpec
rspec 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.
reportPeriodLastDay :: ReportSpec -> Maybe Day
reportPeriodLastDay :: ReportSpec -> Maybe Day
reportPeriodLastDay = (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Day -> Day
addDays (-Integer
1)) (Maybe Day -> Maybe Day)
-> (ReportSpec -> Maybe Day) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Query -> Maybe Day
queryEndDate Bool
False (Query -> Maybe Day)
-> (ReportSpec -> Query) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> Query
rsQuery

-- 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 we're doing period-end valuation, include price
-- directive dates. If there's no report period and nothing in the
-- journal, will be Nothing.
reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ReportSpec
rspec Journal
j = ReportSpec -> Maybe Day
reportPeriodLastDay ReportSpec
rspec Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
journalOrPriceEnd
  where
    journalOrPriceEnd :: Maybe Day
journalOrPriceEnd = case ReportOpts -> Maybe ValuationType
value_ (ReportOpts -> Maybe ValuationType)
-> ReportOpts -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
rsOpts ReportSpec
rspec of
        Just (AtEnd Maybe Text
_) -> Maybe Day -> Maybe Day -> Maybe Day
forall a. Ord a => a -> a -> a
max (Bool -> Journal -> Maybe Day
journalEndDate Bool
False Journal
j) Maybe Day
lastPriceDirective
        Maybe ValuationType
_              -> Bool -> Journal -> Maybe Day
journalEndDate Bool
False Journal
j
    lastPriceDirective :: Maybe Day
lastPriceDirective = (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Day -> Day
addDays Integer
1) (Maybe Day -> Maybe Day)
-> ([PriceDirective] -> Maybe Day) -> [PriceDirective] -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
maximumMay ([Day] -> Maybe Day)
-> ([PriceDirective] -> [Day]) -> [PriceDirective] -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PriceDirective -> Day) -> [PriceDirective] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> Day
pddate ([PriceDirective] -> Maybe Day) -> [PriceDirective] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j