{-|

Options common to most hledger reports.

-}

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators #-}

module Hledger.Reports.ReportOptions (
  ReportOpts(..),
  HasReportOptsNoUpdate(..),
  HasReportOpts(..),
  ReportSpec(..),
  HasReportSpec(..),
  SortField(..),
  SortSpec,
  sortKeysDescription,
  overEither,
  setEither,
  BalanceCalculation(..),
  BalanceAccumulation(..),
  AccountListMode(..),
  ValuationType(..),
  Layout(..),
  defreportopts,
  rawOptsToReportOpts,
  defreportspec,
  defsortspec,
  setDefaultConversionOp,
  reportOptsToSpec,
  updateReportSpec,
  updateReportSpecWith,
  rawOptsToReportSpec,
  balanceAccumulationOverride,
  flat_,
  tree_,
  reportOptsToggleStatus,
  simplifyStatuses,
  whichDate,
  journalValueAndFilterPostings,
  journalValueAndFilterPostingsWith,
  journalApplyValuationFromOpts,
  journalApplyValuationFromOptsWith,
  mixedAmountApplyValuationAfterSumFromOptsWith,
  valuationAfterSum,
  requiresHistorical,
  intervalFromRawOpts,
  queryFromFlags,
  transactionDateFn,
  postingDateFn,
  reportSpan,
  reportSpanBothDates,
  reportStartDate,
  reportEndDate,
  reportPeriodStart,
  reportPeriodOrJournalStart,
  reportPeriodLastDay,
  reportPeriodOrJournalLastDay,
  reportPeriodName
)
where

import Prelude hiding (Applicative(..))
import Control.Applicative (Applicative(..), Const(..), (<|>))
import Control.Monad (guard, join)
import Data.Char (toLower)
import Data.Either (fromRight)
import Data.Either.Extra (eitherToMaybe)
import Data.Functor.Identity (Identity(..))
import Data.List (partition)
import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text qualified as T
import Data.Time.Calendar (Day, addDays)
import Data.Default (Default(..))
import Safe (lastDef, lastMay, maximumMay, readMay)

import Hledger.Data
import Hledger.Query
import Hledger.Utils
import Data.Function ((&))

-- | What to calculate for each cell in a balance report.
-- "Balance report types -> Calculation type" in the hledger manual.
data BalanceCalculation =
    CalcChange        -- ^ Sum of posting amounts in the period.
  | CalcBudget        -- ^ Sum of posting amounts and the goal for the period.
  | CalcValueChange   -- ^ Change from previous period's historical end value to this period's historical end value.
  | CalcGain          -- ^ Change from previous period's gain, i.e. valuation minus cost basis.
  | CalcPostingsCount -- ^ Number of postings in the period.
  deriving (BalanceCalculation -> BalanceCalculation -> Bool
(BalanceCalculation -> BalanceCalculation -> Bool)
-> (BalanceCalculation -> BalanceCalculation -> Bool)
-> Eq BalanceCalculation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalanceCalculation -> BalanceCalculation -> Bool
== :: BalanceCalculation -> BalanceCalculation -> Bool
$c/= :: BalanceCalculation -> BalanceCalculation -> Bool
/= :: BalanceCalculation -> BalanceCalculation -> Bool
Eq, Int -> BalanceCalculation -> ShowS
[BalanceCalculation] -> ShowS
BalanceCalculation -> [Char]
(Int -> BalanceCalculation -> ShowS)
-> (BalanceCalculation -> [Char])
-> ([BalanceCalculation] -> ShowS)
-> Show BalanceCalculation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceCalculation -> ShowS
showsPrec :: Int -> BalanceCalculation -> ShowS
$cshow :: BalanceCalculation -> [Char]
show :: BalanceCalculation -> [Char]
$cshowList :: [BalanceCalculation] -> ShowS
showList :: [BalanceCalculation] -> ShowS
Show)

instance Default BalanceCalculation where def :: BalanceCalculation
def = BalanceCalculation
CalcChange

-- | How to accumulate calculated values across periods (columns) in a balance report.
-- "Balance report types -> Accumulation type" in the hledger manual.
data BalanceAccumulation =
    PerPeriod   -- ^ No accumulation. Eg, shows the change of balance in each period.
  | Cumulative  -- ^ Accumulate changes across periods, starting from zero at report start.
  | Historical  -- ^ Accumulate changes across periods, including any from before report start.
                --   Eg, shows the historical end balance of each period.
  deriving (BalanceAccumulation -> BalanceAccumulation -> Bool
(BalanceAccumulation -> BalanceAccumulation -> Bool)
-> (BalanceAccumulation -> BalanceAccumulation -> Bool)
-> Eq BalanceAccumulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalanceAccumulation -> BalanceAccumulation -> Bool
== :: BalanceAccumulation -> BalanceAccumulation -> Bool
$c/= :: BalanceAccumulation -> BalanceAccumulation -> Bool
/= :: BalanceAccumulation -> BalanceAccumulation -> Bool
Eq,Int -> BalanceAccumulation -> ShowS
[BalanceAccumulation] -> ShowS
BalanceAccumulation -> [Char]
(Int -> BalanceAccumulation -> ShowS)
-> (BalanceAccumulation -> [Char])
-> ([BalanceAccumulation] -> ShowS)
-> Show BalanceAccumulation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceAccumulation -> ShowS
showsPrec :: Int -> BalanceAccumulation -> ShowS
$cshow :: BalanceAccumulation -> [Char]
show :: BalanceAccumulation -> [Char]
$cshowList :: [BalanceAccumulation] -> ShowS
showList :: [BalanceAccumulation] -> ShowS
Show)

instance Default BalanceAccumulation where def :: BalanceAccumulation
def = BalanceAccumulation
PerPeriod

-- | 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
$c== :: AccountListMode -> AccountListMode -> Bool
== :: AccountListMode -> AccountListMode -> Bool
$c/= :: AccountListMode -> AccountListMode -> Bool
/= :: AccountListMode -> AccountListMode -> Bool
Eq, Int -> AccountListMode -> ShowS
[AccountListMode] -> ShowS
AccountListMode -> [Char]
(Int -> AccountListMode -> ShowS)
-> (AccountListMode -> [Char])
-> ([AccountListMode] -> ShowS)
-> Show AccountListMode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountListMode -> ShowS
showsPrec :: Int -> AccountListMode -> ShowS
$cshow :: AccountListMode -> [Char]
show :: AccountListMode -> [Char]
$cshowList :: [AccountListMode] -> ShowS
showList :: [AccountListMode] -> ShowS
Show)

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

data Layout = LayoutWide (Maybe Int)
            | LayoutTall
            | LayoutBare
            | LayoutTidy
  deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
/= :: Layout -> Layout -> Bool
Eq, Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> [Char]
(Int -> Layout -> ShowS)
-> (Layout -> [Char]) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Layout -> ShowS
showsPrec :: Int -> Layout -> ShowS
$cshow :: Layout -> [Char]
show :: Layout -> [Char]
$cshowList :: [Layout] -> ShowS
showList :: [Layout] -> ShowS
Show)

-- | 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 -> Maybe ConversionOp
conversionop_     :: Maybe ConversionOp  -- ^ Which operation should we apply to conversion transactions?
    ,ReportOpts -> Maybe ValuationType
value_            :: Maybe ValuationType  -- ^ What value should amounts be converted to ?
    ,ReportOpts -> Bool
infer_prices_     :: Bool      -- ^ Infer market prices from transactions ?
    ,ReportOpts -> DepthSpec
depth_            :: DepthSpec
    ,ReportOpts -> Bool
date2_            :: Bool
    ,ReportOpts -> Bool
empty_            :: Bool
    ,ReportOpts -> Bool
no_elide_         :: Bool
    ,ReportOpts -> Bool
real_             :: Bool
    ,ReportOpts -> StringFormat
format_           :: StringFormat
    ,ReportOpts -> Maybe Text
balance_base_url_ :: Maybe T.Text
    ,ReportOpts -> Bool
pretty_           :: Bool
    ,ReportOpts -> [Text]
querystring_      :: [T.Text]
    --
    ,ReportOpts -> Bool
average_          :: Bool
    -- for posting reports (register)
    ,ReportOpts -> Bool
related_          :: Bool
    -- for sorting reports (register)
    ,ReportOpts -> SortSpec
sortspec_             :: SortSpec
    -- for account transactions reports (aregister)
    ,ReportOpts -> Bool
txn_dates_        :: Bool
    -- for balance reports (bal, bs, cf, is)
    ,ReportOpts -> BalanceCalculation
balancecalc_      :: BalanceCalculation  -- ^ What to calculate in balance report cells
    ,ReportOpts -> BalanceAccumulation
balanceaccum_     :: BalanceAccumulation -- ^ How to accumulate balance report values over time
    ,ReportOpts -> Maybe Text
budgetpat_        :: Maybe T.Text  -- ^ A case-insensitive description substring
                                        --   to select periodic transactions for budget reports.
                                        --   (Not a regexp, nor a full hledger query, for now.)
    ,ReportOpts -> AccountListMode
accountlistmode_  :: AccountListMode
    ,ReportOpts -> Int
drop_             :: Int
    ,ReportOpts -> Bool
declared_         :: Bool  -- ^ Include accounts declared but not yet posted to ?
    ,ReportOpts -> Bool
row_total_        :: Bool
    ,ReportOpts -> Bool
no_total_         :: Bool
    ,ReportOpts -> Bool
summary_only_     :: Bool
    ,ReportOpts -> Bool
show_costs_       :: Bool  -- ^ Show costs for reports which normally don't show them ?
    ,ReportOpts -> Bool
sort_amount_      :: Bool
    ,ReportOpts -> Bool
percent_          :: Bool
    ,ReportOpts -> Bool
invert_           :: Bool  -- ^ 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 -> Bool
transpose_        :: Bool
    ,ReportOpts -> Layout
layout_           :: Layout
 } deriving (Int -> ReportOpts -> ShowS
[ReportOpts] -> ShowS
ReportOpts -> [Char]
(Int -> ReportOpts -> ShowS)
-> (ReportOpts -> [Char])
-> ([ReportOpts] -> ShowS)
-> Show ReportOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportOpts -> ShowS
showsPrec :: Int -> ReportOpts -> ShowS
$cshow :: ReportOpts -> [Char]
show :: ReportOpts -> [Char]
$cshowList :: [ReportOpts] -> ShowS
showList :: [ReportOpts] -> ShowS
Show)

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

defreportopts :: ReportOpts
defreportopts :: ReportOpts
defreportopts = ReportOpts
    { period_ :: Period
period_           = Period
PeriodAll
    , interval_ :: Interval
interval_         = Interval
NoInterval
    , statuses_ :: [Status]
statuses_         = []
    , conversionop_ :: Maybe ConversionOp
conversionop_     = Maybe ConversionOp
forall a. Maybe a
Nothing
    , value_ :: Maybe ValuationType
value_            = Maybe ValuationType
forall a. Maybe a
Nothing
    , infer_prices_ :: Bool
infer_prices_     = Bool
False
    , depth_ :: DepthSpec
depth_            = Maybe Int -> [(Regexp, Int)] -> DepthSpec
DepthSpec 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
    , balance_base_url_ :: Maybe Text
balance_base_url_ = Maybe Text
forall a. Maybe a
Nothing
    , pretty_ :: Bool
pretty_           = Bool
False
    , querystring_ :: [Text]
querystring_      = []
    , average_ :: Bool
average_          = Bool
False
    , related_ :: Bool
related_          = Bool
False
    , sortspec_ :: SortSpec
sortspec_         = SortSpec
defsortspec 
    , txn_dates_ :: Bool
txn_dates_        = Bool
False
    , balancecalc_ :: BalanceCalculation
balancecalc_      = BalanceCalculation
forall a. Default a => a
def
    , balanceaccum_ :: BalanceAccumulation
balanceaccum_     = BalanceAccumulation
forall a. Default a => a
def
    , budgetpat_ :: Maybe Text
budgetpat_        = Maybe Text
forall a. Maybe a
Nothing
    , accountlistmode_ :: AccountListMode
accountlistmode_  = AccountListMode
ALFlat
    , drop_ :: Int
drop_             = Int
0
    , declared_ :: Bool
declared_         = Bool
False
    , row_total_ :: Bool
row_total_        = Bool
False
    , no_total_ :: Bool
no_total_         = Bool
False
    , summary_only_ :: Bool
summary_only_     = Bool
False
    , show_costs_ :: Bool
show_costs_       = 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
    , transpose_ :: Bool
transpose_        = Bool
False
    , layout_ :: Layout
layout_           = Maybe Int -> Layout
LayoutWide Maybe Int
forall a. Maybe a
Nothing
    }

-- | Generate a ReportOpts from raw command-line input, given a day and whether to use ANSI colour/styles in standard output.
-- This will fail with a usage error if it is passed
-- - an invalid --format argument,
-- - an invalid --value argument,
-- - if --valuechange is called with a valuation type other than -V/--value=end.
-- - an invalid --pretty argument,
rawOptsToReportOpts :: Day -> Bool -> RawOpts -> ReportOpts
rawOptsToReportOpts :: Day -> Bool -> RawOpts -> ReportOpts
rawOptsToReportOpts Day
d Bool
usecoloronstdout RawOpts
rawopts =

    let formatstring :: Maybe Text
formatstring = [Char] -> Text
T.pack ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"format" RawOpts
rawopts
        querystring :: [Text]
querystring  = ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack ([[Char]] -> [Text]) -> [[Char]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"args" RawOpts
rawopts  -- doesn't handle an arg like "" right
        pretty :: Bool
pretty = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe Bool
ynopt [Char]
"pretty" RawOpts
rawopts

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

    in ReportOpts
defreportopts
          {period_           = periodFromRawOpts d rawopts
          ,interval_         = intervalFromRawOpts rawopts
          ,statuses_         = statusesFromRawOpts rawopts
          ,conversionop_     = conversionOpFromRawOpts rawopts
          ,value_            = valuationTypeFromRawOpts rawopts
          ,infer_prices_     = boolopt "infer-market-prices" rawopts
          ,depth_            = depthFromRawOpts rawopts
          ,date2_            = boolopt "date2" rawopts
          ,empty_            = boolopt "empty" rawopts
          ,no_elide_         = boolopt "no-elide" rawopts
          ,real_             = boolopt "real" rawopts
          ,format_           = format
          ,balance_base_url_ = T.pack <$> maybestringopt "base-url" rawopts
          ,querystring_      = querystring
          ,average_          = boolopt "average" rawopts
          ,related_          = boolopt "related" rawopts
          ,sortspec_         = getSortSpec rawopts
          ,txn_dates_        = boolopt "txn-dates" rawopts
          ,balancecalc_      = balancecalcopt rawopts
          ,balanceaccum_     = balanceaccumopt rawopts
          ,budgetpat_        = maybebudgetpatternopt rawopts
          ,accountlistmode_  = accountlistmodeopt rawopts
          ,drop_             = posintopt "drop" rawopts
          ,declared_         = boolopt "declared" rawopts
          ,row_total_        = boolopt "row-total" rawopts
          ,no_total_         = boolopt "no-total" rawopts
          ,summary_only_     = boolopt "summary-only" rawopts
          ,show_costs_       = boolopt "show-costs" rawopts
          ,sort_amount_      = boolopt "sort-amount" rawopts
          ,percent_          = boolopt "percent" rawopts
          ,invert_           = boolopt "invert" rawopts
          ,pretty_           = pretty
          ,color_            = usecoloronstdout
          ,transpose_        = boolopt "transpose" rawopts
          ,layout_           = layoutopt rawopts
          }

-- | A fully-determined set of report parameters 
-- (report options with all partial values made total, eg the begin and end
-- dates are known, avoiding date/regex errors; plus the reporting date),
-- and the query successfully calculated from them.
--
-- If you change the report options or date in one of these, you should
-- use `reportOptsToSpec` to regenerate the whole thing, avoiding inconsistency.
--
data ReportSpec = ReportSpec
  { ReportSpec -> ReportOpts
_rsReportOpts :: ReportOpts  -- ^ The underlying ReportOpts used to generate this ReportSpec
  , ReportSpec -> Day
_rsDay        :: 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 -> [Char]
(Int -> ReportSpec -> ShowS)
-> (ReportSpec -> [Char])
-> ([ReportSpec] -> ShowS)
-> Show ReportSpec
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportSpec -> ShowS
showsPrec :: Int -> ReportSpec -> ShowS
$cshow :: ReportSpec -> [Char]
show :: ReportSpec -> [Char]
$cshowList :: [ReportSpec] -> ShowS
showList :: [ReportSpec] -> ShowS
Show)

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

defreportspec :: ReportSpec
defreportspec :: ReportSpec
defreportspec = ReportSpec
    { _rsReportOpts :: ReportOpts
_rsReportOpts = ReportOpts
forall a. Default a => a
def
    , _rsDay :: Day
_rsDay        = Day
nulldate
    , _rsQuery :: Query
_rsQuery      = Query
Any
    , _rsQueryOpts :: [QueryOpt]
_rsQueryOpts  = []
    }

-- | Set the default ConversionOp.
setDefaultConversionOp :: ConversionOp -> ReportSpec -> ReportSpec
setDefaultConversionOp :: ConversionOp -> ReportSpec -> ReportSpec
setDefaultConversionOp ConversionOp
defop rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} =
    ReportSpec
rspec{_rsReportOpts=ropts{conversionop_=conversionop_ ropts <|> Just defop}}

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
. ([Char] -> Maybe AccountListMode)
-> RawOpts -> Maybe AccountListMode
forall a. ([Char] -> Maybe a) -> RawOpts -> Maybe a
choiceopt [Char] -> Maybe AccountListMode
parse where
    parse :: [Char] -> Maybe AccountListMode
parse = \case
      [Char]
"tree" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALTree
      [Char]
"flat" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALFlat
      [Char]
_      -> Maybe AccountListMode
forall a. Maybe a
Nothing

-- Get the argument of the --budget option if any, or the empty string.
maybebudgetpatternopt :: RawOpts -> Maybe T.Text
maybebudgetpatternopt :: RawOpts -> Maybe Text
maybebudgetpatternopt = ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack (Maybe [Char] -> Maybe Text)
-> (RawOpts -> Maybe [Char]) -> RawOpts -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"budget"

balancecalcopt :: RawOpts -> BalanceCalculation
balancecalcopt :: RawOpts -> BalanceCalculation
balancecalcopt =
  BalanceCalculation
-> Maybe BalanceCalculation -> BalanceCalculation
forall a. a -> Maybe a -> a
fromMaybe BalanceCalculation
CalcChange (Maybe BalanceCalculation -> BalanceCalculation)
-> (RawOpts -> Maybe BalanceCalculation)
-> RawOpts
-> BalanceCalculation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Maybe BalanceCalculation)
-> RawOpts -> Maybe BalanceCalculation
forall a. ([Char] -> Maybe a) -> RawOpts -> Maybe a
choiceopt [Char] -> Maybe BalanceCalculation
parse where
    parse :: [Char] -> Maybe BalanceCalculation
parse = \case
      [Char]
"sum"         -> BalanceCalculation -> Maybe BalanceCalculation
forall a. a -> Maybe a
Just BalanceCalculation
CalcChange
      [Char]
"valuechange" -> BalanceCalculation -> Maybe BalanceCalculation
forall a. a -> Maybe a
Just BalanceCalculation
CalcValueChange
      [Char]
"gain"        -> BalanceCalculation -> Maybe BalanceCalculation
forall a. a -> Maybe a
Just BalanceCalculation
CalcGain
      [Char]
"budget"      -> BalanceCalculation -> Maybe BalanceCalculation
forall a. a -> Maybe a
Just BalanceCalculation
CalcBudget
      [Char]
"count"       -> BalanceCalculation -> Maybe BalanceCalculation
forall a. a -> Maybe a
Just BalanceCalculation
CalcPostingsCount
      [Char]
_             -> Maybe BalanceCalculation
forall a. Maybe a
Nothing

balanceaccumopt :: RawOpts -> BalanceAccumulation
balanceaccumopt :: RawOpts -> BalanceAccumulation
balanceaccumopt = BalanceAccumulation
-> Maybe BalanceAccumulation -> BalanceAccumulation
forall a. a -> Maybe a -> a
fromMaybe BalanceAccumulation
PerPeriod (Maybe BalanceAccumulation -> BalanceAccumulation)
-> (RawOpts -> Maybe BalanceAccumulation)
-> RawOpts
-> BalanceAccumulation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride

ynopt :: String -> RawOpts -> Maybe Bool
ynopt :: [Char] -> RawOpts -> Maybe Bool
ynopt [Char]
opt RawOpts
rawopts = case [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
opt RawOpts
rawopts of
    Just [Char]
"always" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Just [Char]
"yes"    -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Just [Char]
"y"      -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Just [Char]
"never"  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Just [Char]
"no"     -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Just [Char]
"n"      -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Just [Char]
_        -> [Char] -> Maybe Bool
forall a. [Char] -> a
usageError [Char]
"this argument should be one of y, yes, n, no"
    Maybe [Char]
_             -> Maybe Bool
forall a. Maybe a
Nothing

balanceAccumulationOverride :: RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride :: RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride RawOpts
rawopts = ([Char] -> Maybe BalanceAccumulation)
-> RawOpts -> Maybe BalanceAccumulation
forall a. ([Char] -> Maybe a) -> RawOpts -> Maybe a
choiceopt [Char] -> Maybe BalanceAccumulation
parse RawOpts
rawopts Maybe BalanceAccumulation
-> Maybe BalanceAccumulation -> Maybe BalanceAccumulation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe BalanceAccumulation
reportbal
  where
    parse :: [Char] -> Maybe BalanceAccumulation
parse = \case
      [Char]
"historical" -> BalanceAccumulation -> Maybe BalanceAccumulation
forall a. a -> Maybe a
Just BalanceAccumulation
Historical
      [Char]
"cumulative" -> BalanceAccumulation -> Maybe BalanceAccumulation
forall a. a -> Maybe a
Just BalanceAccumulation
Cumulative
      [Char]
"change"     -> BalanceAccumulation -> Maybe BalanceAccumulation
forall a. a -> Maybe a
Just BalanceAccumulation
PerPeriod
      [Char]
_            -> Maybe BalanceAccumulation
forall a. Maybe a
Nothing
    reportbal :: Maybe BalanceAccumulation
reportbal = case RawOpts -> BalanceCalculation
balancecalcopt RawOpts
rawopts of
      BalanceCalculation
CalcValueChange -> BalanceAccumulation -> Maybe BalanceAccumulation
forall a. a -> Maybe a
Just BalanceAccumulation
PerPeriod
      BalanceCalculation
_               -> Maybe BalanceAccumulation
forall a. Maybe a
Nothing

layoutopt :: RawOpts -> Layout
layoutopt :: RawOpts -> Layout
layoutopt RawOpts
rawopts = Layout -> Maybe Layout -> Layout
forall a. a -> Maybe a -> a
fromMaybe (Maybe Int -> Layout
LayoutWide Maybe Int
forall a. Maybe a
Nothing) (Maybe Layout -> Layout) -> Maybe Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Maybe Layout
layout Maybe Layout -> Maybe Layout -> Maybe Layout
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Layout
column
  where
    layout :: Maybe Layout
layout = [Char] -> Layout
parse ([Char] -> Layout) -> Maybe [Char] -> Maybe Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"layout" RawOpts
rawopts
    column :: Maybe Layout
column = Layout
LayoutBare Layout -> Maybe () -> Maybe Layout
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char] -> RawOpts -> Bool
boolopt [Char]
"commodity-column" RawOpts
rawopts)

    parse :: [Char] -> Layout
parse [Char]
opt = Layout
-> (([Char], Layout) -> Layout) -> Maybe ([Char], Layout) -> Layout
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Layout
forall {a}. a
err ([Char], Layout) -> Layout
forall a b. (a, b) -> b
snd (Maybe ([Char], Layout) -> Layout)
-> Maybe ([Char], Layout) -> Layout
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s) Maybe () -> Maybe ([Char], Layout) -> Maybe ([Char], Layout)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (([Char], Layout) -> Bool)
-> [([Char], Layout)] -> Maybe ([Char], Layout)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
s ([Char] -> Bool)
-> (([Char], Layout) -> [Char]) -> ([Char], Layout) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Layout) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Layout)]
checkNames
      where
        checkNames :: [([Char], Layout)]
checkNames = [ ([Char]
"wide", Maybe Int -> Layout
LayoutWide Maybe Int
w)
                     , ([Char]
"tall", Layout
LayoutTall)
                     , ([Char]
"bare", Layout
LayoutBare)
                     , ([Char]
"tidy", Layout
LayoutTidy)
                     ]
        -- For `--layout=elided,n`, elide to the given width
        ([Char]
s,[Char]
n) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
opt
        w :: Maybe Int
w = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
n of
              [Char]
"" -> Maybe Int
forall a. Maybe a
Nothing
              [Char]
c | Just Int
w' <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
c -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w'
              [Char]
_ -> [Char] -> Maybe Int
forall a. [Char] -> a
usageError [Char]
"width in --layout=wide,WIDTH must be an integer"

        err :: a
err = [Char] -> a
forall a. [Char] -> a
usageError [Char]
"--layout's argument should be \"wide[,WIDTH]\", \"tall\", \"bare\", or \"tidy\""

-- 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 -> [EFDay]
beginDatesFromRawOpts Day
d RawOpts
rawopts of
                   [] -> Maybe Day
forall a. Maybe a
Nothing
                   [EFDay]
bs -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay (EFDay -> Day) -> EFDay -> Day
forall a b. (a -> b) -> a -> b
$ [EFDay] -> EFDay
forall a. HasCallStack => [a] -> a
last [EFDay]
bs
    mlaste :: Maybe Day
mlaste = case Day -> RawOpts -> [EFDay]
endDatesFromRawOpts Day
d RawOpts
rawopts of
                   [] -> Maybe Day
forall a. Maybe a
Nothing
                   [EFDay]
es -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay (EFDay -> Day) -> EFDay -> Day
forall a b. (a -> b) -> a -> b
$ [EFDay] -> EFDay
forall a. HasCallStack => [a] -> a
last [EFDay]
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 -> [EFDay]
beginDatesFromRawOpts :: Day -> RawOpts -> [EFDay]
beginDatesFromRawOpts Day
d = (([Char], [Char]) -> Maybe EFDay) -> RawOpts -> [EFDay]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> ([Char], [Char]) -> Maybe EFDay
begindatefromrawopt Day
d)
  where
    begindatefromrawopt :: Day -> ([Char], [Char]) -> Maybe EFDay
begindatefromrawopt Day
d' ([Char]
n,[Char]
v)
      | [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"begin" =
          (HledgerParseErrors -> Maybe EFDay)
-> (EFDay -> Maybe EFDay)
-> Either HledgerParseErrors EFDay
-> Maybe EFDay
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\HledgerParseErrors
e -> [Char] -> Maybe EFDay
forall a. [Char] -> a
usageError ([Char] -> Maybe EFDay) -> [Char] -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
n[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" date: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e) EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (Either HledgerParseErrors EFDay -> Maybe EFDay)
-> Either HledgerParseErrors EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' Day
d' ([Char] -> Text
T.pack [Char]
v)
      | [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"period" =
        case
          (HledgerParseErrors -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either HledgerParseErrors (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\HledgerParseErrors
e -> [Char] -> (Interval, DateSpan)
forall a. [Char] -> a
usageError ([Char] -> (Interval, DateSpan)) -> [Char] -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse period option: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either HledgerParseErrors (Interval, DateSpan)
 -> (Interval, DateSpan))
-> Either HledgerParseErrors (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d' (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
v)
        of
          (Interval
_, DateSpan (Just EFDay
b) Maybe EFDay
_) -> EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just EFDay
b
          (Interval, DateSpan)
_                        -> Maybe EFDay
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe EFDay
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 -> [EFDay]
endDatesFromRawOpts :: Day -> RawOpts -> [EFDay]
endDatesFromRawOpts Day
d = (([Char], [Char]) -> Maybe EFDay) -> RawOpts -> [EFDay]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> ([Char], [Char]) -> Maybe EFDay
enddatefromrawopt Day
d)
  where
    enddatefromrawopt :: Day -> ([Char], [Char]) -> Maybe EFDay
enddatefromrawopt Day
d' ([Char]
n,[Char]
v)
      | [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"end" =
          (HledgerParseErrors -> Maybe EFDay)
-> (EFDay -> Maybe EFDay)
-> Either HledgerParseErrors EFDay
-> Maybe EFDay
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\HledgerParseErrors
e -> [Char] -> Maybe EFDay
forall a. [Char] -> a
usageError ([Char] -> Maybe EFDay) -> [Char] -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
n[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" date: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e) EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (Either HledgerParseErrors EFDay -> Maybe EFDay)
-> Either HledgerParseErrors EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' Day
d' ([Char] -> Text
T.pack [Char]
v)
      | [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"period" =
        case
          (HledgerParseErrors -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either HledgerParseErrors (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\HledgerParseErrors
e -> [Char] -> (Interval, DateSpan)
forall a. [Char] -> a
usageError ([Char] -> (Interval, DateSpan)) -> [Char] -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse period option: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either HledgerParseErrors (Interval, DateSpan)
 -> (Interval, DateSpan))
-> Either HledgerParseErrors (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
          Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d' (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
v)
        of
          (Interval
_, DateSpan Maybe EFDay
_ (Just EFDay
e)) -> EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just EFDay
e
          (Interval, DateSpan)
_                        -> Maybe EFDay
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe EFDay
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
. (([Char], [Char]) -> Maybe Interval) -> RawOpts -> [Interval]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts ([Char], [Char]) -> Maybe Interval
forall {a}. (Eq a, IsString a) => (a, [Char]) -> Maybe Interval
intervalfromrawopt
  where
    intervalfromrawopt :: (a, [Char]) -> Maybe Interval
intervalfromrawopt (a
n,[Char]
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"period" =
          (HledgerParseErrors -> Maybe Interval)
-> ((Interval, DateSpan) -> Maybe Interval)
-> Either HledgerParseErrors (Interval, DateSpan)
-> Maybe Interval
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\HledgerParseErrors
e -> [Char] -> Maybe Interval
forall a. [Char] -> a
usageError ([Char] -> Maybe Interval) -> [Char] -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse period option: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e)
            (Interval, DateSpan) -> Maybe Interval
extractIntervalOrNothing (Either HledgerParseErrors (Interval, DateSpan) -> Maybe Interval)
-> Either HledgerParseErrors (Interval, DateSpan) -> Maybe Interval
forall a b. (a -> b) -> a -> b
$
            Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr
              ([Char] -> Day
forall a. [Char] -> a
error' [Char]
"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
$ [Char] -> Text
T.pack [Char]
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

-- | 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
. (([Char], [Char]) -> Maybe Status) -> RawOpts -> [Status]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts ([Char], [Char]) -> 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 a. [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 a. [a] -> 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
ss = ReportOpts
ropts{statuses_=filter (/= s) ss}
  | Bool
otherwise   = ReportOpts
ropts{statuses_=simplifyStatuses (s:ss)}

-- | Parse the type of valuation to be performed, if any, specified by -V,
-- -X/--exchange, or --value flags. If there's more than one valuation type,
-- the rightmost flag wins. This will fail with a usage error if an invalid
-- argument is passed to --value, or if --valuechange is called with a
-- valuation type other than -V/--value=end.
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts RawOpts
rawopts = case (RawOpts -> BalanceCalculation
balancecalcopt RawOpts
rawopts, Maybe ValuationType
directval) of
    (BalanceCalculation
CalcValueChange, 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
    (BalanceCalculation
CalcValueChange, Just (AtEnd Maybe Text
_)) -> Maybe ValuationType
directval             -- If AtEnd valuation requested, use it
    (BalanceCalculation
CalcValueChange, Maybe ValuationType
_             ) -> [Char] -> Maybe ValuationType
forall a. [Char] -> a
usageError [Char]
"--valuechange only produces sensible results with --value=end"
    (BalanceCalculation
CalcGain,        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 gain, use AtEnd
    (BalanceCalculation
_,               Maybe ValuationType
_             ) -> 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
$ (([Char], [Char]) -> Maybe ValuationType)
-> RawOpts -> [ValuationType]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts ([Char], [Char]) -> Maybe ValuationType
forall {a}.
(Eq a, IsString a) =>
(a, [Char]) -> Maybe ValuationType
valuationfromrawopt RawOpts
rawopts
    valuationfromrawopt :: (a, [Char]) -> Maybe ValuationType
valuationfromrawopt (a
n,[Char]
v)  -- option name, value
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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
AtEnd Maybe Text
forall a. Maybe a
Nothing
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"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
AtEnd (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
v)
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"value" = [Char] -> Maybe ValuationType
valueopt [Char]
v
      | Bool
otherwise    = Maybe ValuationType
forall a. Maybe a
Nothing
    valueopt :: [Char] -> Maybe ValuationType
valueopt [Char]
v
      | [Char]
t [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"cost",[Char]
"c"]  = 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
      | [Char]
t [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"then" ,[Char]
"t"] = 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
      | [Char]
t [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"end" ,[Char]
"e"]  = 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
      | [Char]
t [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"now" ,[Char]
"n"]  = 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 [Char] -> Maybe Day
parsedate [Char]
t of
            Just Day
d  -> 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 -> [Char] -> Maybe ValuationType
forall a. [Char] -> a
usageError ([Char] -> Maybe ValuationType) -> [Char] -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse \""[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
t[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD"
      where
        -- parse --value's value: TYPE[,COMM]
        ([Char]
t,[Char]
c') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') [Char]
v
        mc :: Maybe Text
mc     = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
c' of
                   [Char]
"" -> Maybe Text
forall a. Maybe a
Nothing
                   [Char]
c  -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
c

-- | Parse the type of costing to be performed, if any, specified by -B/--cost
-- or --value flags. If there's more than one costing type, the rightmost flag
-- wins. This will fail with a usage error if an invalid argument is passed to
-- --cost or if a costing type is requested with --gain.
conversionOpFromRawOpts :: RawOpts -> Maybe ConversionOp
conversionOpFromRawOpts :: RawOpts -> Maybe ConversionOp
conversionOpFromRawOpts RawOpts
rawopts
    | Maybe ConversionOp -> Bool
forall a. Maybe a -> Bool
isJust Maybe ConversionOp
costFlag Bool -> Bool -> Bool
&& RawOpts -> BalanceCalculation
balancecalcopt RawOpts
rawopts BalanceCalculation -> BalanceCalculation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceCalculation
CalcGain = [Char] -> Maybe ConversionOp
forall a. [Char] -> a
usageError [Char]
"--gain cannot be combined with --cost"
    | Bool
otherwise = Maybe ConversionOp
costFlag
  where
    costFlag :: Maybe ConversionOp
costFlag = [ConversionOp] -> Maybe ConversionOp
forall a. [a] -> Maybe a
lastMay ([ConversionOp] -> Maybe ConversionOp)
-> [ConversionOp] -> Maybe ConversionOp
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> Maybe ConversionOp)
-> RawOpts -> [ConversionOp]
forall a. (([Char], [Char]) -> Maybe a) -> RawOpts -> [a]
collectopts ([Char], [Char]) -> Maybe ConversionOp
forall {a}. (Eq a, IsString a) => (a, [Char]) -> Maybe ConversionOp
conversionopfromrawopt RawOpts
rawopts
    conversionopfromrawopt :: (a, [Char]) -> Maybe ConversionOp
conversionopfromrawopt (a
n,[Char]
v)  -- option name, value
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"B"                                    = ConversionOp -> Maybe ConversionOp
forall a. a -> Maybe a
Just ConversionOp
ToCost
      | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"value", (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') [Char]
v [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"cost", [Char]
"c"] = ConversionOp -> Maybe ConversionOp
forall a. a -> Maybe a
Just ConversionOp
ToCost  -- keep supporting --value=cost for now
      | Bool
otherwise                                   = Maybe ConversionOp
forall a. Maybe a
Nothing

-- | Parse the depth arguments. This can be either a flat depth that applies to
-- all accounts, or a regular expression and depth, which only matches certain
-- accounts. If an account name is matched by a regular expression, then the
-- smallest depth is used. Otherwise, if no regular expressions match, then the
-- flat depth is used. If more than one flat depth is supplied, use only the
-- last one.
depthFromRawOpts :: RawOpts -> DepthSpec
depthFromRawOpts :: RawOpts -> DepthSpec
depthFromRawOpts RawOpts
rawopts = DepthSpec -> [DepthSpec] -> DepthSpec
forall a. a -> [a] -> a
lastDef DepthSpec
forall a. Monoid a => a
mempty [DepthSpec]
flats DepthSpec -> DepthSpec -> DepthSpec
forall a. Semigroup a => a -> a -> a
<> [DepthSpec] -> DepthSpec
forall a. Monoid a => [a] -> a
mconcat [DepthSpec]
regexps
  where
    ([DepthSpec]
flats, [DepthSpec]
regexps) = (DepthSpec -> Bool) -> [DepthSpec] -> ([DepthSpec], [DepthSpec])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(DepthSpec Maybe Int
f [(Regexp, Int)]
rs) -> Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
f Bool -> Bool -> Bool
&& [(Regexp, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Regexp, Int)]
rs) [DepthSpec]
depthSpecs
    depthSpecs :: [DepthSpec]
depthSpecs = case ([Char] -> Either [Char] DepthSpec)
-> [[Char]] -> Either [Char] [DepthSpec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text -> Either [Char] DepthSpec
parseDepthSpec (Text -> Either [Char] DepthSpec)
-> ([Char] -> Text) -> [Char] -> Either [Char] DepthSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) [[Char]]
depths of
      Right [DepthSpec]
d -> [DepthSpec]
d
      Left [Char]
err -> [Char] -> [DepthSpec]
forall a. [Char] -> a
usageError ([Char] -> [DepthSpec]) -> [Char] -> [DepthSpec]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse depth specification: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
    depths :: [[Char]]
depths = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"depth" RawOpts
rawopts

-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> (Transaction -> Day)
transactionDateFn :: ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
conversionop_ :: ReportOpts -> Maybe ConversionOp
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
date2_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
balance_base_url_ :: ReportOpts -> Maybe Text
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
average_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
txn_dates_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
budgetpat_ :: ReportOpts -> Maybe Text
accountlistmode_ :: ReportOpts -> AccountListMode
drop_ :: ReportOpts -> Int
declared_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
invert_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
color_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} = 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]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
conversionop_ :: ReportOpts -> Maybe ConversionOp
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
date2_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
balance_base_url_ :: ReportOpts -> Maybe Text
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
average_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
txn_dates_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
budgetpat_ :: ReportOpts -> Maybe Text
accountlistmode_ :: ReportOpts -> AccountListMode
drop_ :: ReportOpts -> Int
declared_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
invert_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
color_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} = if Bool
date2_ then Posting -> Day
postingDate2 else Posting -> Day
postingDate

-- | Report which date we will report on based on --date2.
whichDate :: ReportOpts -> WhichDate
whichDate :: ReportOpts -> WhichDate
whichDate ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
conversionop_ :: ReportOpts -> Maybe ConversionOp
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
date2_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
balance_base_url_ :: ReportOpts -> Maybe Text
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
average_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
txn_dates_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
budgetpat_ :: ReportOpts -> Maybe Text
accountlistmode_ :: ReportOpts -> AccountListMode
drop_ :: ReportOpts -> Int
declared_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
invert_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
color_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} = 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 a 'Journal''s amounts to cost and/or to value (see
-- 'journalApplyValuationFromOpts'), and filter by the 'ReportSpec' 'Query'.
--
-- We make sure to first filter by amt: and cur: terms, then value the
-- 'Journal', then filter by the remaining terms.
journalValueAndFilterPostings :: ReportSpec -> Journal -> Journal
journalValueAndFilterPostings :: ReportSpec -> Journal -> Journal
journalValueAndFilterPostings ReportSpec
rspec Journal
j =
  -- dbg4With (\j2 -> "valuedfilteredj" <> pshow (jtxns j2)) $
  ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith ReportSpec
rspec Journal
j PriceOracle
priceoracle
  where priceoracle :: PriceOracle
priceoracle = Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_prices_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) Journal
j

{- [Querying before valuation]
This helper is used by multiBalanceReport (all balance reports).
Previously, at least since #1625 (2021), it was filtering with the cur:/amt: parts
of the query before valuation, and with the other parts after valuation.
Now, since #2387 (2025), it does all filtering before valuation.
This avoids breaking boolean queries (#2371), avoids a strictness bug (#2385),
is simpler, and we think it's otherwise equivalent.
-}
-- | Like 'journalValueAndFilterPostings', but takes a 'PriceOracle' as an argument.
journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith = ReportSpec -> Journal -> PriceOracle -> Journal
_journalValueAndFilterPostingsWith1431

-- 1.42
-- #2371 This goes wrong with complex boolean queries, splitting them apart in a lossy way.
-- _journalValueAndFilterPostingsWith142 rspec@ReportSpec{_rsQuery=q, _rsReportOpts=ropts} j =
--     -- Third, filter by the non amt:/cur: parts of the query
--       filterJournalPostings' reportq
--     -- Second, apply valuation and costing
--     . journalApplyValuationFromOptsWith rspec
--     -- First, filter by the amt:/cur: parts of the query, so they match pre-valuation amounts
--       (if queryIsNull amtsymq then j else filterJournalAmounts amtsymq j)
--   where
--     -- with -r, replace each posting with its sibling postings
--     filterJournalPostings' = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings
--     amtsymq = dbg1 "amtsymq" $ filterQuery queryIsAmtOrSym q
--     reportq = dbg1 "reportq" $ filterQuery (not . queryIsAmtOrSym) q

-- 1.43
-- XXX #2396 This goes wrong with cur:. filterJournal*Postings keep all postings containing the matched commodity,
-- but do not remove the unmatched commodities from multicommodity postings, as filterJournalAmounts would.
-- _journalValueAndFilterPostingsWith143 rspec@ReportSpec{_rsQuery = q, _rsReportOpts = ropts} =
--   journalApplyValuationFromOptsWith rspec .
--   dbg1With (\j1 -> "j1" <> pshow (jtxns j1)) .
--   (if related_ ropts then filterJournalRelatedPostings else filterJournalPostings) q

-- 1.43.1
_journalValueAndFilterPostingsWith1431 :: ReportSpec -> Journal -> PriceOracle -> Journal
_journalValueAndFilterPostingsWith1431 rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery = Query
q, _rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts = ReportOpts
ropts} =
  ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith ReportSpec
rspec (Journal -> PriceOracle -> Journal)
-> (Journal -> Journal) -> Journal -> PriceOracle -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Journal -> Journal
filterjournal Query
q
  where
    filterjournal :: Query -> Journal -> Journal
filterjournal Query
q2 =
      Query -> Journal -> Journal
filterJournalAmounts ((Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAmtOrSym Query
q2) (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- an extra amount filtering pass for #2396
      (if ReportOpts -> Bool
related_ ReportOpts
ropts then Query -> Journal -> Journal
filterJournalRelatedPostings Query
q2 else Query -> Journal -> Journal
filterJournalPostings Query
q2)

-- | Convert this journal's postings' amounts to cost and/or to value, if specified
-- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This
-- should be the main stop for performing costing and valuation. The exception is
-- whenever you need to perform valuation _after_ summing up amounts, as in a
-- historical balance report with --value=end. valuationAfterSum will check for this
-- condition.
journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts ReportSpec
rspec Journal
j =
  ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith ReportSpec
rspec Journal
j PriceOracle
priceoracle
  where priceoracle :: PriceOracle
priceoracle = Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_prices_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) Journal
j

-- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument.
journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle =
  Journal -> Journal
costfn Journal
j
  Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& (Posting -> Posting) -> Journal -> Journal
journalMapPostings (\Posting
p -> Posting
p
    Posting -> (Posting -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& (Posting -> [Char]) -> Posting -> Posting
forall a. (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl [Char]
"before calc"ShowS -> (Posting -> [Char]) -> Posting -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> [Char]
showMixedAmountOneLine(MixedAmount -> [Char])
-> (Posting -> MixedAmount) -> Posting -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> MixedAmount
pamount)
    Posting -> (Posting -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount (Posting -> MixedAmount -> MixedAmount
calcfn Posting
p)
    Posting -> (Posting -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& (Posting -> [Char]) -> Posting -> Posting
forall a. (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl (BalanceCalculation -> [Char]
forall a. Show a => a -> [Char]
show BalanceCalculation
calc)ShowS -> (Posting -> [Char]) -> Posting -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> [Char]
showMixedAmountOneLine(MixedAmount -> [Char])
-> (Posting -> MixedAmount) -> Posting -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> MixedAmount
pamount)
    )
  where
    lbl :: [Char] -> ShowS
lbl = [Char] -> [Char] -> ShowS
lbl_ [Char]
"journalApplyValuationFromOptsWith"
    -- Which custom calculation to do for balance reports. For all other reports, it will be CalcChange.
    calc :: BalanceCalculation
calc = ReportOpts -> BalanceCalculation
balancecalc_ ReportOpts
ropts
    calcfn :: Posting -> MixedAmount -> MixedAmount
calcfn = case BalanceCalculation
calc of
      BalanceCalculation
CalcGain -> \Posting
p -> (MixedAmount -> MixedAmount)
-> (ValuationType -> MixedAmount -> MixedAmount)
-> Maybe ValuationType
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyGain      PriceOracle
priceoracle Map Text AmountStyle
styles (Posting -> Day
postingperiodend Posting
p) (ReportSpec -> Day
_rsDay ReportSpec
rspec) (Posting -> Day
postingDate Posting
p)) (ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts)
      BalanceCalculation
_        -> \Posting
p -> (MixedAmount -> MixedAmount)
-> (ValuationType -> MixedAmount -> MixedAmount)
-> Maybe ValuationType
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles (Posting -> Day
postingperiodend Posting
p) (ReportSpec -> Day
_rsDay ReportSpec
rspec) (Posting -> Day
postingDate Posting
p)) (ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts)
    costfn :: Journal -> Journal
costfn = case BalanceCalculation
calc of
      BalanceCalculation
CalcGain -> Journal -> Journal
forall a. a -> a
id
      BalanceCalculation
_        -> ConversionOp -> Journal -> Journal
journalToCost ConversionOp
costop where costop :: ConversionOp
costop = ConversionOp -> Maybe ConversionOp -> ConversionOp
forall a. a -> Maybe a -> a
fromMaybe ConversionOp
NoConversionOp (Maybe ConversionOp -> ConversionOp)
-> Maybe ConversionOp -> ConversionOp
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts

    -- Find the "end" valuation date for this posting.
    -- With a report interval, this is the last day of the report subperiod containing this posting;
    -- with no interval it's the last date of the overall report period
    -- (which for an end value report may have been extended to include the latest non-future P directive).
    -- To get the period's last day, we subtract one from the (exclusive) period end date.
    postingperiodend :: Posting -> Day
postingperiodend = Day -> Day
postingPeriodEnd (Day -> Day) -> (Posting -> Day) -> Posting -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhichDate -> Posting -> Day
postingDateOrDate2 (ReportOpts -> WhichDate
whichDate ReportOpts
ropts)
      where
        postingPeriodEnd :: Day -> Day
postingPeriodEnd Day
d = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
forall {a}. a
err (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> Interval
interval_ ReportOpts
ropts of
          Interval
NoInterval -> (DayPartition -> Day) -> Maybe DayPartition -> Maybe Day
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Day, Day) -> Day
forall a b. (a, b) -> b
snd ((Day, Day) -> Day)
-> (DayPartition -> (Day, Day)) -> DayPartition -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayPartition -> (Day, Day)
dayPartitionStartEnd)    (Maybe DayPartition -> Maybe Day)
-> ((DateSpan, Maybe DayPartition) -> Maybe DayPartition)
-> (DateSpan, Maybe DayPartition)
-> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan, Maybe DayPartition) -> Maybe DayPartition
forall a b. (a, b) -> b
snd ((DateSpan, Maybe DayPartition) -> Maybe Day)
-> (DateSpan, Maybe DayPartition) -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpan Journal
j ReportSpec
rspec
          Interval
_          -> (DayPartition -> Day) -> Maybe DayPartition -> Maybe Day
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Day, Day) -> Day
forall a b. (a, b) -> b
snd ((Maybe Day, Day) -> Day)
-> (DayPartition -> (Maybe Day, Day)) -> DayPartition -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> DayPartition -> (Maybe Day, Day)
dayPartitionFind Day
d) (Maybe DayPartition -> Maybe Day)
-> ((DateSpan, Maybe DayPartition) -> Maybe DayPartition)
-> (DateSpan, Maybe DayPartition)
-> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan, Maybe DayPartition) -> Maybe DayPartition
forall a b. (a, b) -> b
snd ((DateSpan, Maybe DayPartition) -> Maybe Day)
-> (DateSpan, Maybe DayPartition) -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanBothDates Journal
j ReportSpec
rspec
        -- Should never happen, because there are only invalid dayPartitions
        -- when there are no transactions, in which case this function is never called
        err :: a
err = [Char] -> a
forall a. [Char] -> a
error' [Char]
"journalApplyValuationFromOpts: expected all spans to have an end date"


    styles :: Map Text AmountStyle
styles = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j

-- | Select the Account valuation functions required for performing valuation after summing
-- amounts. Used in MultiBalanceReport to value historical and similar reports.
mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle
                                              -> (Day -> MixedAmount -> MixedAmount)
mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts
-> Journal -> PriceOracle -> Day -> MixedAmount -> MixedAmount
mixedAmountApplyValuationAfterSumFromOptsWith ReportOpts
ropts Journal
j PriceOracle
priceoracle =
    case ReportOpts -> Maybe (Maybe Text)
valuationAfterSum ReportOpts
ropts of
        Just Maybe Text
mc -> case ReportOpts -> BalanceCalculation
balancecalc_ ReportOpts
ropts of
            BalanceCalculation
CalcGain -> Maybe Text -> Day -> MixedAmount -> MixedAmount
gain Maybe Text
mc
            BalanceCalculation
_        -> \Day
d -> Maybe Text -> Day -> MixedAmount -> MixedAmount
valuation Maybe Text
mc Day
d (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
costing
        Maybe (Maybe Text)
Nothing      -> (MixedAmount -> MixedAmount) -> Day -> MixedAmount -> MixedAmount
forall a b. a -> b -> a
const MixedAmount -> MixedAmount
forall a. a -> a
id
  where
    valuation :: Maybe Text -> Day -> MixedAmount -> MixedAmount
valuation Maybe Text
mc Day
d = PriceOracle
-> Map Text AmountStyle
-> Maybe Text
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountValueAtDate PriceOracle
priceoracle Map Text AmountStyle
styles Maybe Text
mc Day
d
    gain :: Maybe Text -> Day -> MixedAmount -> MixedAmount
gain Maybe Text
mc Day
d = PriceOracle
-> Map Text AmountStyle
-> Maybe Text
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountGainAtDate PriceOracle
priceoracle Map Text AmountStyle
styles Maybe Text
mc Day
d
    costing :: MixedAmount -> MixedAmount
costing = case ConversionOp -> Maybe ConversionOp -> ConversionOp
forall a. a -> Maybe a -> a
fromMaybe ConversionOp
NoConversionOp (Maybe ConversionOp -> ConversionOp)
-> Maybe ConversionOp -> ConversionOp
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts of
        ConversionOp
NoConversionOp -> MixedAmount -> MixedAmount
forall a. a -> a
id
        ConversionOp
ToCost         -> Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
mixedAmountCost
    styles :: Map Text AmountStyle
styles = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j

-- | If the ReportOpts specify that we are performing valuation after summing amounts,
-- return Just of the commodity symbol we're converting to, Just Nothing for the default,
-- and otherwise return Nothing.
-- Used for example with historical reports with --value=end.
valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol)
valuationAfterSum :: ReportOpts -> Maybe (Maybe Text)
valuationAfterSum ReportOpts
ropts = case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
    Just (AtEnd Maybe Text
mc) | ReportOpts -> Bool
requiresHistorical ReportOpts
ropts -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
mc
    Maybe ValuationType
_                                          -> Maybe (Maybe Text)
forall a. Maybe a
Nothing

-- | If the ReportOpts specify that we will need to consider historical
-- postings, either because this is a historical report, or because the
-- valuation strategy requires historical amounts.
requiresHistorical :: ReportOpts -> Bool
requiresHistorical :: ReportOpts -> Bool
requiresHistorical ReportOpts{balanceaccum_ :: ReportOpts -> BalanceAccumulation
balanceaccum_ = BalanceAccumulation
accum, balancecalc_ :: ReportOpts -> BalanceCalculation
balancecalc_ = BalanceCalculation
calc} =
    BalanceAccumulation
accum BalanceAccumulation -> BalanceAccumulation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
Historical Bool -> Bool -> Bool
|| BalanceCalculation
calc BalanceCalculation -> BalanceCalculation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceCalculation
CalcValueChange Bool -> Bool -> Bool
|| BalanceCalculation
calc BalanceCalculation -> BalanceCalculation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceCalculation
CalcGain

-- | 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]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
conversionop_ :: ReportOpts -> Maybe ConversionOp
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
date2_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
balance_base_url_ :: ReportOpts -> Maybe Text
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
average_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
txn_dates_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
budgetpat_ :: ReportOpts -> Maybe Text
accountlistmode_ :: ReportOpts -> AccountListMode
drop_ :: ReportOpts -> Int
declared_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
invert_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
color_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} = 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} {b}. (a -> b) -> Maybe a -> [b] -> [b]
consJust Int -> Query
Depth Maybe Int
flatDepth
           ([Query] -> [Query]) -> [Query] -> [Query]
forall a b. (a -> b) -> a -> b
$ ((Regexp, Int) -> Query) -> [(Regexp, Int)] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map ((Regexp -> Int -> Query) -> (Regexp, Int) -> Query
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Regexp -> Int -> Query
DepthAcct) [(Regexp, Int)]
regexpDepths
           [Query] -> [Query] -> [Query]
forall a. [a] -> [a] -> [a]
++  [ (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
True:) else [a] -> [a]
forall a. a -> a
id
    DepthSpec Maybe Int
flatDepth [(Regexp, Int)]
regexpDepths = DepthSpec
depth_
    consJust :: (a -> b) -> Maybe a -> [b] -> [b]
consJust a -> b
f = ([b] -> [b]) -> (a -> [b] -> [b]) -> Maybe a -> [b] -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [b] -> [b]
forall a. a -> a
id ((:) (b -> [b] -> [b]) -> (a -> b) -> a -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- Methods/types needed for --sort argument

-- Possible arguments taken by the --sort command
-- Each of these takes a bool, which shows if it has been inverted
-- (True -> has been inverted, reverse the order)
data SortField
    = AbsAmount' Bool
    | Account' Bool
    | Amount' Bool
    | Date' Bool
    | Description' Bool
    deriving (Int -> SortField -> ShowS
SortSpec -> ShowS
SortField -> [Char]
(Int -> SortField -> ShowS)
-> (SortField -> [Char]) -> (SortSpec -> ShowS) -> Show SortField
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortField -> ShowS
showsPrec :: Int -> SortField -> ShowS
$cshow :: SortField -> [Char]
show :: SortField -> [Char]
$cshowList :: SortSpec -> ShowS
showList :: SortSpec -> ShowS
Show, SortField -> SortField -> Bool
(SortField -> SortField -> Bool)
-> (SortField -> SortField -> Bool) -> Eq SortField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortField -> SortField -> Bool
== :: SortField -> SortField -> Bool
$c/= :: SortField -> SortField -> Bool
/= :: SortField -> SortField -> Bool
Eq)
type SortSpec = [SortField]

-- By default, sort by date in ascending order
defsortspec :: SortSpec
defsortspec :: SortSpec
defsortspec = [Bool -> SortField
Date' Bool
False]

-- Load a SortSpec from the argument given to --sort
-- If there is no spec given, then sort by [Date' False] by default
getSortSpec :: RawOpts -> SortSpec
getSortSpec :: RawOpts -> SortSpec
getSortSpec RawOpts
opts = 
    let opt :: Maybe [Char]
opt = [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"sort" RawOpts
opts
        optParser :: [Char] -> SortSpec
optParser [Char]
s = 
          let terms :: [[Char]]
terms = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
strip ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> [[Char]]
forall a. Eq a => a -> [a] -> [[a]]
splitAtElement Char
',' [Char]
s 
              termParser :: [Char] -> SortField
termParser [Char]
t = case [Char]
trimmed of
                [Char]
"date"        -> Bool -> SortField
Date'        Bool
isNegated
                [Char]
"desc"        -> Bool -> SortField
Description' Bool
isNegated
                [Char]
"description" -> Bool -> SortField
Description' Bool
isNegated
                [Char]
"account"     -> Bool -> SortField
Account'     Bool
isNegated
                [Char]
"amount"      -> Bool -> SortField
Amount'      Bool
isNegated
                [Char]
"absamount"   -> Bool -> SortField
AbsAmount'   Bool
isNegated
                [Char]
_ -> [Char] -> SortField
forall a. [Char] -> a
error' ([Char] -> SortField) -> [Char] -> SortField
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown --sort key " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". Supported keys are: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
sortKeysDescription [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
                where isNegated :: Bool
isNegated = [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"-" [Char]
t
                      trimmed :: [Char]
trimmed = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
t ([Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"-" [Char]
t)
          in ([Char] -> SortField) -> [[Char]] -> SortSpec
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SortField
termParser [[Char]]
terms
    in SortSpec -> ([Char] -> SortSpec) -> Maybe [Char] -> SortSpec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SortSpec
defsortspec [Char] -> SortSpec
optParser Maybe [Char]
opt 

-- for option's help and parse error message
sortKeysDescription :: [Char]
sortKeysDescription = [Char]
"date, desc, account, amount, absamount"  -- 'description' is also accepted

-- Report dates.

-- | The effective report span is the start and end dates requested by options or queries.
-- If the start date is unspecified, the earliest transaction or posting date is used.
-- If the end date is unspecified, the latest transaction or posting date
-- (or non-future market price date, when doing an end value report) is used.
-- If none of these things are present, the null date span is returned.
-- The report sub-periods caused by a report interval, if any, are also returned.
reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpan = Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanHelper Bool
False
-- Note: In end value reports, the report end date and valuation date are the same.
-- If valuation date ever needs to be different, journalApplyValuationFromOptsWith is the place.

-- | Like reportSpan, but considers both primary and secondary dates, not just one or the other.
reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanBothDates = Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanHelper Bool
True

reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
reportSpanHelper Bool
bothdates Journal
j ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query, _rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts, _rsDay :: ReportSpec -> Day
_rsDay=Day
today} =
    (DateSpan
enlargedreportspan, Maybe DayPartition
intervalspans)
  where
    -- The date span specified by -b/-e/-p options and query args if any.
    requestedspan :: DateSpan
requestedspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"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 the requested span has open ends, fill them with defaults.
    reportspan :: DateSpan
reportspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
requestedspan DateSpan -> DateSpan -> DateSpan
`spanValidDefaultsFrom` DateSpan
txnsorpricespan
      where
        txnsorpricespan :: DateSpan
txnsorpricespan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"txnsorpricespan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
mfirsttxn Maybe EFDay
mlatesttxnorprice
          where
            DateSpan Maybe EFDay
mfirsttxn Maybe EFDay
mlasttxn = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"txnsspan" (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
            mlatesttxnorprice :: Maybe EFDay
mlatesttxnorprice =
              case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
                Just (AtEnd Maybe Text
_) -> Maybe EFDay
mlasttxn Maybe EFDay -> Maybe EFDay -> Maybe EFDay
forall a. Ord a => a -> a -> a
`max` Maybe EFDay
mlatestnonfutureprice
                Maybe ValuationType
_              -> Maybe EFDay
mlasttxn
              where
                mlatestnonfutureprice :: Maybe EFDay
mlatestnonfutureprice = [Char] -> Maybe EFDay -> Maybe EFDay
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"latestnonfutureprice" (Maybe EFDay -> Maybe EFDay) -> Maybe EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ -- #2445
                  (Day -> EFDay) -> Maybe Day -> Maybe EFDay
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Day -> EFDay
Exact (Day -> EFDay) -> (Day -> Day) -> Day -> EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> Day -> Day
addDays Year
1) (Maybe Day -> Maybe EFDay)
-> ([PriceDirective] -> Maybe Day)
-> [PriceDirective]
-> Maybe EFDay
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
. (Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Day -> Bool) -> Day -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
today)) ([Day] -> [Day])
-> ([PriceDirective] -> [Day]) -> [PriceDirective] -> [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 EFDay)
-> [PriceDirective] -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j

    -- 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 :: Maybe DayPartition
intervalspans = [Char] -> Maybe DayPartition -> Maybe DayPartition
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"intervalspans" (Maybe DayPartition -> Maybe DayPartition)
-> Maybe DayPartition -> Maybe DayPartition
forall a b. (a -> b) -> a -> b
$ Bool -> Interval -> DateSpan -> Maybe DayPartition
splitSpan Bool
adjust (ReportOpts -> Interval
interval_ ReportOpts
ropts) DateSpan
reportspan
      where
        -- When calculating report periods, we will adjust the start date back to the nearest interval boundary
        -- unless a start date was specified explicitly.
        adjust :: Bool
adjust = Maybe Day -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Day -> Bool) -> Maybe Day -> Bool
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanStart DateSpan
requestedspan

    -- The requested span enlarged to enclose a whole number of intervals.
    -- This can be the null span if there were no intervals.
    enlargedreportspan :: DateSpan
enlargedreportspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"enlargedreportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$
        DateSpan
-> (DayPartition -> DateSpan) -> Maybe DayPartition -> DateSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
forall a. Maybe a
Nothing Maybe EFDay
forall a. Maybe a
Nothing) ((Day, Day) -> DateSpan
mkSpan ((Day, Day) -> DateSpan)
-> (DayPartition -> (Day, Day)) -> DayPartition -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayPartition -> (Day, Day)
dayPartitionStartEnd) Maybe DayPartition
intervalspans
      where mkSpan :: (Day, Day) -> DateSpan
mkSpan (Day
s, Day
e) = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact Day
s) (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> (Day -> EFDay) -> Day -> Maybe EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> EFDay
Exact (Day -> Maybe EFDay) -> Day -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
1 Day
e)

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
. (DateSpan, Maybe DayPartition) -> DateSpan
forall a b. (a, b) -> a
fst ((DateSpan, Maybe DayPartition) -> DateSpan)
-> (ReportSpec -> (DateSpan, Maybe DayPartition))
-> ReportSpec
-> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
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
. (DateSpan, Maybe DayPartition) -> DateSpan
forall a b. (a, b) -> a
fst ((DateSpan, Maybe DayPartition) -> DateSpan)
-> (ReportSpec -> (DateSpan, Maybe DayPartition))
-> ReportSpec
-> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
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 a. Maybe a -> Maybe a -> Maybe a
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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Year -> Day -> Day
addDays (-Year
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 a. Maybe a -> Maybe a -> Maybe a
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
_rsReportOpts 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
journalLastDay Bool
False Journal
j) Maybe Day
lastPriceDirective
        Maybe ValuationType
_              -> Bool -> Journal -> Maybe Day
journalLastDay Bool
False Journal
j
    lastPriceDirective :: Maybe Day
lastPriceDirective = (Day -> Day) -> Maybe Day -> Maybe Day
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Year -> Day -> Day
addDays Year
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

-- | Make a name for the given period in a multiperiod report, given
-- the type of balance being reported and the full set of report
-- periods. This will be used as a column heading (or row heading, in
-- a register summary report). We try to pick a useful name as follows:
--
-- - ending-balance reports: the period's end date
--
-- - balance change reports where the periods are months and all in the same year:
--   the short month name in the current locale
--
-- - all other balance change reports: a description of the datespan,
--   abbreviated to compact form if possible (see showDateSpan).
reportPeriodName :: BalanceAccumulation -> [DateSpan] -> DateSpan -> T.Text
reportPeriodName :: BalanceAccumulation -> [DateSpan] -> DateSpan -> Text
reportPeriodName BalanceAccumulation
balanceaccumulation [DateSpan]
spans =
  case BalanceAccumulation
balanceaccumulation of
    BalanceAccumulation
PerPeriod -> if Bool
multiyear then DateSpan -> Text
showDateSpan else DateSpan -> Text
showDateSpanAbbrev
      where
        multiyear :: Bool
multiyear = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe Year] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe Year] -> Int) -> [Maybe Year] -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe Year] -> [Maybe Year]
forall {a}. Ord a => [a] -> [a]
nubSort ([Maybe Year] -> [Maybe Year]) -> [Maybe Year] -> [Maybe Year]
forall a b. (a -> b) -> a -> b
$ (DateSpan -> Maybe Year) -> [DateSpan] -> [Maybe Year]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> Maybe Year
spanStartYear [DateSpan]
spans
    BalanceAccumulation
_ -> Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Day -> Text
showDate (Day -> Text) -> (Day -> Day) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Day
prevday) (Maybe Day -> Text) -> (DateSpan -> Maybe Day) -> DateSpan -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd

-- lenses

-- Reportable functors are so that we can create special lenses which can fail
-- and report on their failure.
class Functor f => Reportable f e where
    report :: a -> f (Either e a) -> f a

instance Reportable (Const r) e where
    report :: forall a. a -> Const r (Either e a) -> Const r a
report a
_ (Const r
x) = r -> Const r a
forall {k} a (b :: k). a -> Const a b
Const r
x

instance Reportable Identity e where
    report :: forall a. a -> Identity (Either e a) -> Identity a
report a
a (Identity Either e a
i) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ a -> Either e a -> a
forall b a. b -> Either a b -> b
fromRight a
a Either e a
i

instance Reportable Maybe e where
    report :: forall a. a -> Maybe (Either e a) -> Maybe a
report a
_ = (Either e a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe =<<)

instance (e ~ a) => Reportable (Either a) e where
    report :: forall a. a -> Either a (Either e a) -> Either a a
report a
_ = Either e (Either e a) -> Either e a
Either a (Either e a) -> Either a a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

-- | Apply a function over a lens, but report on failure.
overEither :: ((a -> Either e b) -> s -> Either e t) -> (a -> b) -> s -> Either e t
overEither :: forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither (a -> Either e b) -> s -> Either e t
l a -> b
f = (a -> Either e b) -> s -> Either e t
l (b -> Either e b
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either e b) -> (a -> b) -> a -> Either e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | Set a field using a lens, but report on failure.
setEither :: ((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
setEither :: forall a e b s t.
((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
setEither (a -> Either e b) -> s -> Either e t
l = ((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither (a -> Either e b) -> s -> Either e t
l ((a -> b) -> s -> Either e t)
-> (b -> a -> b) -> b -> s -> Either e t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const

type ReportableLens' s a = forall f. Reportable f String => (a -> f a) -> s -> f s

-- | Lenses for ReportOpts.

-- Implement HasReportOptsNoUpdate, the basic lenses for ReportOpts.
makeHledgerClassyLenses ''ReportOpts
makeHledgerClassyLenses ''ReportSpec

-- | Special lenses for ReportOpts which also update the Query and QueryOpts in ReportSpec.
-- Note that these are not true lenses, as they have a further restriction on
-- the functor. This will work as a normal lens for all common uses, but since they
-- don't obey the lens laws for some fancy cases, they may fail in some exotic circumstances.
--
-- Note that setEither/overEither should only be necessary with
-- querystring and reportOpts: the other lenses should never fail.
--
-- === Examples:
-- >>> import Lens.Micro (set)
-- >>> _rsQuery <$> setEither querystring ["assets"] defreportspec
-- Right (Acct (RegexpCI "assets"))
-- >>> _rsQuery <$> setEither querystring ["(assets"] defreportspec
-- Left "This regular expression is invalid or unsupported, please correct it:\n(assets"
-- >>> _rsQuery $ set querystring ["assets"] defreportspec
-- Acct (RegexpCI "assets")
-- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec
-- Date DateSpan 2021-08
--
-- XXX testing error output isn't working since adding color to it:
-- > import System.Environment
-- > setEnv "NO_COLOR" "1" >> return (_rsQuery $ set querystring ["(assets"] defreportspec)
-- *** Exception: Error: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set
class HasReportOptsNoUpdate a => HasReportOpts a where
    reportOpts :: ReportableLens' a ReportOpts
    reportOpts = (ReportOpts -> f ReportOpts) -> a -> f a
forall c. HasReportOptsNoUpdate c => Lens' c ReportOpts
Lens' a ReportOpts
reportOptsNoUpdate
    {-# INLINE reportOpts #-}

    -- XXX these names are a bit clashy

    period :: ReportableLens' a Period
    period = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> ((Period -> f Period) -> ReportOpts -> f ReportOpts)
-> (Period -> f Period)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Period -> f Period) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c Period
Lens' ReportOpts Period
periodNoUpdate
    {-# INLINE period #-}

    statuses :: ReportableLens' a [Status]
    statuses = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> (([Status] -> f [Status]) -> ReportOpts -> f ReportOpts)
-> ([Status] -> f [Status])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Status] -> f [Status]) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c [Status]
Lens' ReportOpts [Status]
statusesNoUpdate
    {-# INLINE statuses #-}

    depth :: ReportableLens' a DepthSpec
    depth = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> ((DepthSpec -> f DepthSpec) -> ReportOpts -> f ReportOpts)
-> (DepthSpec -> f DepthSpec)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DepthSpec -> f DepthSpec) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c DepthSpec
Lens' ReportOpts DepthSpec
depthNoUpdate
    {-# INLINE depth #-}

    date2 :: ReportableLens' a Bool
    date2 = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> ((Bool -> f Bool) -> ReportOpts -> f ReportOpts)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> f Bool) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c Bool
Lens' ReportOpts Bool
date2NoUpdate
    {-# INLINE date2 #-}

    real :: ReportableLens' a Bool
    real = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> ((Bool -> f Bool) -> ReportOpts -> f ReportOpts)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> f Bool) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c Bool
Lens' ReportOpts Bool
realNoUpdate
    {-# INLINE real #-}

    querystring :: ReportableLens' a [T.Text]
    querystring = (ReportOpts -> f ReportOpts) -> a -> f a
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' a ReportOpts
reportOpts((ReportOpts -> f ReportOpts) -> a -> f a)
-> (([Text] -> f [Text]) -> ReportOpts -> f ReportOpts)
-> ([Text] -> f [Text])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Text] -> f [Text]) -> ReportOpts -> f ReportOpts
forall c. HasReportOptsNoUpdate c => Lens' c [Text]
Lens' ReportOpts [Text]
querystringNoUpdate
    {-# INLINE querystring #-}

instance HasReportOpts ReportOpts

instance HasReportOptsNoUpdate ReportSpec where
    reportOptsNoUpdate :: Lens' ReportSpec ReportOpts
reportOptsNoUpdate = (ReportOpts -> f ReportOpts) -> ReportSpec -> f ReportSpec
forall c. HasReportSpec c => Lens' c ReportOpts
Lens' ReportSpec ReportOpts
rsReportOpts

instance HasReportOpts ReportSpec where
    reportOpts :: ReportableLens' ReportSpec ReportOpts
reportOpts ReportOpts -> f ReportOpts
f ReportSpec
rspec = ReportSpec -> f (Either [Char] ReportSpec) -> f ReportSpec
forall a. a -> f (Either [Char] a) -> f a
forall (f :: * -> *) e a.
Reportable f e =>
a -> f (Either e a) -> f a
report ([Char] -> ReportSpec
forall a. [Char] -> a
error' [Char]
"Updating ReportSpec failed: try using overEither instead of over or setEither instead of set") (f (Either [Char] ReportSpec) -> f ReportSpec)
-> f (Either [Char] ReportSpec) -> f ReportSpec
forall a b. (a -> b) -> a -> b
$  -- PARTIAL:
      Day -> ReportOpts -> Either [Char] ReportSpec
reportOptsToSpec (ReportSpec -> Day
_rsDay ReportSpec
rspec) (ReportOpts -> Either [Char] ReportSpec)
-> f ReportOpts -> f (Either [Char] ReportSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> f ReportOpts
f (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec)
    {-# INLINE reportOpts #-}

-- | Generate a ReportSpec from a set of ReportOpts on a given day.
reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec :: Day -> ReportOpts -> Either [Char] ReportSpec
reportOptsToSpec Day
day ReportOpts
ropts = do
    (Query
argsquery, [QueryOpt]
queryopts) <- Day -> [Text] -> Either [Char] (Query, [QueryOpt])
parseQueryList Day
day ([Text] -> Either [Char] (Query, [QueryOpt]))
-> [Text] -> Either [Char] (Query, [QueryOpt])
forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Text]
querystring_ ReportOpts
ropts
    ReportSpec -> Either [Char] ReportSpec
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ReportSpec
      { _rsReportOpts :: ReportOpts
_rsReportOpts = ReportOpts
ropts
      , _rsDay :: Day
_rsDay        = 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, _rsReportOpts, querystring_, etc.) are in sync.
updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec :: ReportOpts -> ReportSpec -> Either [Char] ReportSpec
updateReportSpec = ((ReportOpts -> Either [Char] ReportOpts)
 -> ReportSpec -> Either [Char] ReportSpec)
-> ReportOpts -> ReportSpec -> Either [Char] ReportSpec
forall a e b s t.
((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
setEither (ReportOpts -> Either [Char] ReportOpts)
-> ReportSpec -> Either [Char] ReportSpec
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' ReportSpec ReportOpts
reportOpts

-- | Like updateReportSpec, but takes a ReportOpts-modifying function.
updateReportSpecWith :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec
updateReportSpecWith :: (ReportOpts -> ReportOpts)
-> ReportSpec -> Either [Char] ReportSpec
updateReportSpecWith = ((ReportOpts -> Either [Char] ReportOpts)
 -> ReportSpec -> Either [Char] ReportSpec)
-> (ReportOpts -> ReportOpts)
-> ReportSpec
-> Either [Char] ReportSpec
forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither (ReportOpts -> Either [Char] ReportOpts)
-> ReportSpec -> Either [Char] ReportSpec
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' ReportSpec ReportOpts
reportOpts

-- | Generate a ReportSpec from RawOpts and a provided day, or return an error
-- string if there are regular expression errors.
rawOptsToReportSpec :: Day -> Bool -> RawOpts -> Either String ReportSpec
rawOptsToReportSpec :: Day -> Bool -> RawOpts -> Either [Char] ReportSpec
rawOptsToReportSpec Day
day Bool
coloronstdout = Day -> ReportOpts -> Either [Char] ReportSpec
reportOptsToSpec Day
day (ReportOpts -> Either [Char] ReportSpec)
-> (RawOpts -> ReportOpts) -> RawOpts -> Either [Char] ReportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Bool -> RawOpts -> ReportOpts
rawOptsToReportOpts Day
day Bool
coloronstdout