2014-03-20 04:11:48 +04:00
{- |
2014-03-26 04:10:30 +04:00
Options common to most hledger reports .
2014-03-20 04:11:48 +04:00
- }
2021-07-27 09:12:02 +03:00
{- # LANGUAGE FlexibleContexts # -}
{- # LANGUAGE FlexibleInstances # -}
{- # LANGUAGE LambdaCase # -}
{- # LANGUAGE MultiParamTypeClasses # -}
{- # LANGUAGE OverloadedStrings # -}
{- # LANGUAGE RankNTypes # -}
{- # LANGUAGE RecordWildCards # -}
2021-08-25 13:04:44 +03:00
{- # LANGUAGE TemplateHaskell # -}
2021-07-27 09:12:02 +03:00
{- # LANGUAGE TypeFamilies # -}
2018-09-04 21:54:40 +03:00
2014-03-20 04:11:48 +04:00
module Hledger.Reports.ReportOptions (
ReportOpts ( .. ) ,
2021-08-25 13:04:44 +03:00
HasReportOptsNoUpdate ( .. ) ,
2021-07-27 09:12:02 +03:00
HasReportOpts ( .. ) ,
2020-09-16 04:45:52 +03:00
ReportSpec ( .. ) ,
2021-07-27 09:12:02 +03:00
HasReportSpec ( .. ) ,
2021-08-25 13:04:44 +03:00
overEither ,
setEither ,
2021-07-15 02:28:43 +03:00
BalanceCalculation ( .. ) ,
BalanceAccumulation ( .. ) ,
2014-12-05 23:56:33 +03:00
AccountListMode ( .. ) ,
2019-05-23 10:36:16 +03:00
ValuationType ( .. ) ,
2014-03-20 04:11:48 +04:00
defreportopts ,
2014-03-26 04:10:30 +04:00
rawOptsToReportOpts ,
2020-09-16 04:45:52 +03:00
defreportspec ,
reportOptsToSpec ,
2020-12-12 23:05:44 +03:00
updateReportSpec ,
updateReportSpecWith ,
2020-09-16 04:45:52 +03:00
rawOptsToReportSpec ,
2021-07-15 02:28:43 +03:00
balanceAccumulationOverride ,
2014-12-05 23:56:33 +03:00
flat_ ,
tree_ ,
2017-06-16 04:15:37 +03:00
reportOptsToggleStatus ,
2017-06-19 02:11:18 +03:00
simplifyStatuses ,
2021-10-10 22:27:09 +03:00
whichDate ,
2021-09-23 09:02:09 +03:00
journalValueAndFilterPostings ,
journalValueAndFilterPostingsWith ,
2021-05-13 12:00:43 +03:00
journalApplyValuationFromOpts ,
journalApplyValuationFromOptsWith ,
2021-05-13 13:48:31 +03:00
mixedAmountApplyValuationAfterSumFromOptsWith ,
valuationAfterSum ,
2018-03-29 17:50:48 +03:00
intervalFromRawOpts ,
2020-09-02 14:00:45 +03:00
queryFromFlags ,
2014-03-20 04:11:48 +04:00
transactionDateFn ,
postingDateFn ,
2018-03-30 02:16:35 +03:00
reportSpan ,
2021-03-02 13:32:52 +03:00
reportSpanBothDates ,
2016-12-30 22:44:01 +03:00
reportStartDate ,
reportEndDate ,
2019-05-06 03:47:38 +03:00
reportPeriodStart ,
reportPeriodOrJournalStart ,
2019-05-04 22:00:57 +03:00
reportPeriodLastDay ,
reportPeriodOrJournalLastDay ,
2021-04-04 02:03:49 +03:00
reportPeriodName
2014-03-20 04:11:48 +04:00
)
where
2021-09-23 09:02:09 +03:00
import Control.Applicative ( Const ( .. ) , ( <|> ) , liftA2 )
2021-07-27 09:12:02 +03:00
import Control.Monad ( ( <=< ) , join )
2021-08-16 09:09:55 +03:00
import Data.Either ( fromRight )
2021-07-27 09:12:02 +03:00
import Data.Either.Extra ( eitherToMaybe )
import Data.Functor.Identity ( Identity ( .. ) )
2020-01-04 09:09:01 +03:00
import Data.List.Extra ( nubSort )
2021-04-14 03:01:00 +03:00
import Data.Maybe ( fromMaybe , mapMaybe )
2016-07-29 18:57:10 +03:00
import qualified Data.Text as T
2020-09-02 14:00:45 +03:00
import Data.Time.Calendar ( Day , addDays )
2020-08-31 07:56:38 +03:00
import Data.Default ( Default ( .. ) )
2021-03-02 13:32:52 +03:00
import Safe ( headMay , lastDef , lastMay , maximumMay )
2020-07-14 22:08:36 +03:00
2018-09-30 04:32:08 +03:00
import Text.Megaparsec.Custom
2014-03-20 04:11:48 +04:00
import Hledger.Data
import Hledger.Query
2018-09-04 23:52:36 +03:00
import Hledger.Utils
2014-03-20 04:11:48 +04:00
2021-07-15 02:28:43 +03:00
-- | What to calculate for each cell in a balance report.
-- "Balance report types -> Calculation type" in the hledger manual.
2021-07-23 08:35:26 +03:00
data BalanceCalculation =
2021-07-15 02:28:43 +03:00
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.
2021-07-23 08:35:26 +03:00
| CalcGain -- ^ Change from previous period's gain, i.e. valuation minus cost basis.
2021-02-08 07:31:17 +03:00
deriving ( Eq , Show )
2021-07-15 02:28:43 +03:00
instance Default BalanceCalculation where def = CalcChange
2021-02-08 07:31:17 +03:00
2021-07-15 02:28:43 +03:00
-- | 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.
2020-08-31 07:56:38 +03:00
deriving ( Eq , Show )
2014-03-26 04:10:30 +04:00
2021-07-15 02:28:43 +03:00
instance Default BalanceAccumulation where def = PerPeriod
2014-03-26 04:10:30 +04:00
2014-12-05 23:56:33 +03:00
-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
2020-08-31 07:56:38 +03:00
data AccountListMode = ALFlat | ALTree deriving ( Eq , Show )
2014-12-05 23:56:33 +03:00
2020-07-07 08:04:39 +03:00
instance Default AccountListMode where def = ALFlat
2014-12-05 23:56:33 +03:00
2017-09-26 08:06:38 +03:00
-- | 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
2019-07-15 13:28:52 +03:00
-- commands, as noted below.
2014-03-20 04:11:48 +04:00
data ReportOpts = ReportOpts {
2020-05-25 02:13:30 +03:00
-- for most reports:
2020-09-16 04:45:52 +03:00
period_ :: Period
2016-07-30 05:19:44 +03:00
, interval_ :: Interval
2017-06-16 02:54:34 +03:00
, statuses_ :: [ Status ] -- ^ Zero, one, or two statuses to be matched
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
, cost_ :: Costing -- ^ Should we convert amounts to cost, when present?
2019-05-23 10:36:16 +03:00
, value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ?
2021-09-10 01:17:34 +03:00
, infer_prices_ :: Bool -- ^ Infer market prices from transactions ?
2014-03-20 04:11:48 +04:00
, depth_ :: Maybe Int
, date2_ :: Bool
, empty_ :: Bool
, no_elide_ :: Bool
, real_ :: Bool
2020-09-02 05:27:46 +03:00
, format_ :: StringFormat
2021-09-22 04:11:47 +03:00
, pretty_ :: Bool
2020-11-04 14:19:26 +03:00
, querystring_ :: [ T . Text ]
2019-05-03 22:24:02 +03:00
--
2014-03-26 04:10:30 +04:00
, average_ :: Bool
2020-05-25 02:13:30 +03:00
-- for posting reports (register)
2014-03-26 04:10:30 +04:00
, related_ :: Bool
2020-05-25 02:13:30 +03:00
-- for account transactions reports (aregister)
, txn_dates_ :: Bool
-- for balance reports (bal, bs, cf, is)
2021-07-15 01:47:11 +03:00
, balancecalc_ :: BalanceCalculation -- ^ What to calculate in balance report cells
, balanceaccum_ :: BalanceAccumulation -- ^ How to accumulate balance report values over time
, 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.)
2016-07-30 05:19:44 +03:00
, accountlistmode_ :: AccountListMode
2014-03-26 04:10:30 +04:00
, drop_ :: Int
2014-12-28 02:16:36 +03:00
, row_total_ :: Bool
2014-03-26 04:10:30 +04:00
, no_total_ :: Bool
2021-04-06 12:18:46 +03:00
, show_costs_ :: Bool -- ^ Whether to show costs for reports which normally don't show them
2017-09-25 19:17:46 +03:00
, sort_amount_ :: Bool
2019-11-11 23:06:58 +03:00
, percent_ :: Bool
2018-01-30 01:52:03 +03:00
, invert_ :: Bool -- ^ if true, flip all amount signs in reports
2018-01-16 00:05:20 +03:00
, normalbalance_ :: Maybe NormalSign
-- ^ This can be set when running balance reports on a set of accounts
2018-01-23 22:32:24 +03:00
-- with the same normal balance type (eg all assets, or all incomes).
2018-01-16 04:58:14 +03:00
-- - It helps --sort-amount know how to sort negative numbers
2019-07-15 13:28:52 +03:00
-- (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.
2017-04-26 04:34:09 +03:00
, color_ :: Bool
2020-07-14 22:08:36 +03:00
-- ^ 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.
2019-01-24 23:54:23 +03:00
, transpose_ :: Bool
2021-07-22 21:04:59 +03:00
, commodity_column_ :: Bool
2020-08-31 07:56:38 +03:00
} deriving ( Show )
2014-03-20 04:11:48 +04:00
2014-03-26 04:10:30 +04:00
instance Default ReportOpts where def = defreportopts
2014-03-20 04:11:48 +04:00
2014-03-26 04:10:30 +04:00
defreportopts :: ReportOpts
2014-03-20 04:11:48 +04:00
defreportopts = ReportOpts
2020-09-16 04:45:52 +03:00
{ period_ = PeriodAll
2020-09-11 09:45:59 +03:00
, interval_ = NoInterval
, statuses_ = []
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
, cost_ = NoCost
2020-09-11 09:45:59 +03:00
, value_ = Nothing
2021-09-10 01:17:34 +03:00
, infer_prices_ = False
2020-09-11 09:45:59 +03:00
, depth_ = Nothing
, date2_ = False
, empty_ = False
, no_elide_ = False
, real_ = False
, format_ = def
2021-09-22 04:11:47 +03:00
, pretty_ = False
2020-11-04 14:19:26 +03:00
, querystring_ = []
2020-09-11 09:45:59 +03:00
, average_ = False
, related_ = False
, txn_dates_ = False
2021-07-15 02:28:43 +03:00
, balancecalc_ = def
, balanceaccum_ = def
2021-07-15 01:47:11 +03:00
, budgetpat_ = Nothing
2020-09-11 09:45:59 +03:00
, accountlistmode_ = ALFlat
, drop_ = 0
, row_total_ = False
, no_total_ = False
2021-04-06 12:18:46 +03:00
, show_costs_ = False
2020-09-11 09:45:59 +03:00
, sort_amount_ = False
, percent_ = False
, invert_ = False
, normalbalance_ = Nothing
, color_ = False
, transpose_ = False
2021-07-22 21:04:59 +03:00
, commodity_column_ = False
2020-09-11 09:45:59 +03:00
}
2017-09-26 08:06:38 +03:00
2021-08-04 07:29:58 +03:00
-- | Generate a ReportOpts from raw command-line input, given a day.
-- 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.
2021-09-22 04:11:47 +03:00
-- - an invalid --pretty argument,
2021-08-04 07:29:58 +03:00
rawOptsToReportOpts :: Day -> RawOpts -> ReportOpts
rawOptsToReportOpts d rawopts =
2020-09-02 14:00:45 +03:00
2021-04-14 03:01:00 +03:00
let formatstring = T . pack <$> maybestringopt " format " rawopts
2020-11-04 14:19:26 +03:00
querystring = map T . pack $ listofstringopt " args " rawopts -- doesn't handle an arg like "" right
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
( costing , valuation ) = valuationTypeFromRawOpts rawopts
2021-09-20 07:02:37 +03:00
pretty = fromMaybe False $ alwaysneveropt " pretty " rawopts
2020-09-02 14:00:45 +03:00
2021-08-04 07:29:58 +03:00
format = case parseStringFormat <$> formatstring of
Nothing -> defaultBalanceLineFormat
Just ( Right x ) -> x
Just ( Left err ) -> usageError $ " could not parse format option: " ++ err
2020-09-02 14:00:45 +03:00
2021-08-04 07:29:58 +03:00
in defreportopts
2020-09-16 04:45:52 +03:00
{ period_ = periodFromRawOpts d rawopts
2020-09-02 14:00:45 +03:00
, interval_ = intervalFromRawOpts rawopts
, statuses_ = statusesFromRawOpts rawopts
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
, cost_ = costing
, value_ = valuation
2021-09-10 01:17:34 +03:00
, infer_prices_ = boolopt " infer-market-prices " rawopts
2020-09-02 14:00:45 +03:00
, depth_ = maybeposintopt " depth " rawopts
, date2_ = boolopt " date2 " rawopts
, empty_ = boolopt " empty " rawopts
, no_elide_ = boolopt " no-elide " rawopts
, real_ = boolopt " real " rawopts
, format_ = format
2020-09-11 09:45:59 +03:00
, querystring_ = querystring
2020-09-02 14:00:45 +03:00
, average_ = boolopt " average " rawopts
, related_ = boolopt " related " rawopts
, txn_dates_ = boolopt " txn-dates " rawopts
2021-07-15 01:47:11 +03:00
, balancecalc_ = balancecalcopt rawopts
2021-07-15 02:28:43 +03:00
, balanceaccum_ = balanceaccumopt rawopts
2021-07-15 01:47:11 +03:00
, budgetpat_ = maybebudgetpatternopt rawopts
2020-09-02 14:00:45 +03:00
, accountlistmode_ = accountlistmodeopt rawopts
, drop_ = posintopt " drop " rawopts
, row_total_ = boolopt " row-total " rawopts
, no_total_ = boolopt " no-total " rawopts
2021-04-06 12:18:46 +03:00
, show_costs_ = boolopt " show-costs " rawopts
2020-09-02 14:00:45 +03:00
, sort_amount_ = boolopt " sort-amount " rawopts
, percent_ = boolopt " percent " rawopts
, invert_ = boolopt " invert " rawopts
2021-09-20 07:02:37 +03:00
, pretty_ = pretty
2021-04-14 03:23:29 +03:00
, color_ = useColorOnStdout -- a lower-level helper
2020-09-02 14:00:45 +03:00
, transpose_ = boolopt " transpose " rawopts
2021-07-22 21:04:59 +03:00
, commodity_column_ = boolopt " commodity-column " rawopts
2020-09-02 14:00:45 +03:00
}
2021-02-08 07:31:17 +03:00
2020-10-23 09:34:31 +03:00
-- | The result of successfully parsing a ReportOpts on a particular
-- Day. Any ambiguous dates are completed and Queries are parsed,
-- ensuring that there are no regular expression errors. Values here
-- should be used in preference to re-deriving them from ReportOpts.
-- If you change the query_ in ReportOpts, you should call
-- `reportOptsToSpec` to regenerate the ReportSpec with the new
-- Query.
2020-09-16 04:45:52 +03:00
data ReportSpec = ReportSpec
2021-07-23 09:47:48 +03:00
{ _rsReportOpts :: ReportOpts -- ^ The underlying ReportOpts used to generate this ReportSpec
, _rsDay :: Day -- ^ The Day this ReportSpec is generated for
, _rsQuery :: Query -- ^ The generated Query for the given day
, _rsQueryOpts :: [ QueryOpt ] -- ^ A list of QueryOpts for the given day
2020-09-16 04:45:52 +03:00
} deriving ( Show )
instance Default ReportSpec where def = defreportspec
defreportspec :: ReportSpec
defreportspec = ReportSpec
2021-07-23 09:47:48 +03:00
{ _rsReportOpts = def
, _rsDay = nulldate
, _rsQuery = Any
, _rsQueryOpts = []
2020-09-16 04:45:52 +03:00
}
2014-12-05 23:56:33 +03:00
accountlistmodeopt :: RawOpts -> AccountListMode
2019-10-20 02:01:59 +03:00
accountlistmodeopt =
2020-07-07 08:04:39 +03:00
fromMaybe ALFlat . choiceopt parse where
2019-10-20 02:01:59 +03:00
parse = \ case
" tree " -> Just ALTree
" flat " -> Just ALFlat
_ -> Nothing
2014-12-05 23:56:33 +03:00
2021-07-15 01:47:11 +03:00
-- Get the argument of the --budget option if any, or the empty string.
maybebudgetpatternopt :: RawOpts -> Maybe T . Text
maybebudgetpatternopt = fmap T . pack . maybestringopt " budget "
2021-07-15 02:28:43 +03:00
balancecalcopt :: RawOpts -> BalanceCalculation
balancecalcopt =
fromMaybe CalcChange . choiceopt parse where
2021-02-08 07:31:17 +03:00
parse = \ case
2021-07-15 02:28:43 +03:00
" sum " -> Just CalcChange
" valuechange " -> Just CalcValueChange
2021-07-23 08:35:26 +03:00
" gain " -> Just CalcGain
2021-07-15 02:28:43 +03:00
" budget " -> Just CalcBudget
2021-02-08 07:31:17 +03:00
_ -> Nothing
2021-07-15 02:28:43 +03:00
balanceaccumopt :: RawOpts -> BalanceAccumulation
balanceaccumopt = fromMaybe PerPeriod . balanceAccumulationOverride
2021-03-05 09:23:07 +03:00
2021-09-20 07:02:37 +03:00
alwaysneveropt :: String -> RawOpts -> Maybe Bool
alwaysneveropt opt rawopts = case maybestringopt opt rawopts of
Just " always " -> Just True
Just " yes " -> Just True
Just " y " -> Just True
Just " never " -> Just False
Just " no " -> Just False
Just " n " -> Just False
2021-09-22 04:42:02 +03:00
Just _ -> usageError " --pretty's argument should be \ " yes \ " or \ " no \ " (or y, n, always, never) "
2021-09-20 07:02:37 +03:00
_ -> Nothing
2021-07-15 02:28:43 +03:00
balanceAccumulationOverride :: RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride rawopts = choiceopt parse rawopts <|> reportbal
2021-03-05 09:23:07 +03:00
where
2019-10-20 02:01:59 +03:00
parse = \ case
2021-07-15 02:28:43 +03:00
" historical " -> Just Historical
" cumulative " -> Just Cumulative
" change " -> Just PerPeriod
2019-10-20 02:01:59 +03:00
_ -> Nothing
2021-07-15 02:28:43 +03:00
reportbal = case balancecalcopt rawopts of
CalcValueChange -> Just PerPeriod
_ -> Nothing
2014-03-26 04:10:30 +04:00
2019-07-01 20:33:06 +03:00
-- 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.
2016-07-30 05:19:44 +03:00
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts d rawopts =
2019-06-29 23:40:18 +03:00
case ( mlastb , mlaste ) of
2016-07-30 05:19:44 +03:00
( Nothing , Nothing ) -> PeriodAll
( Just b , Nothing ) -> PeriodFrom b
( Nothing , Just e ) -> PeriodTo e
2021-07-15 02:28:43 +03:00
( Just b , Just e ) -> simplifyPeriod $ PeriodBetween b e
2016-07-30 05:19:44 +03:00
where
2019-06-29 23:40:18 +03:00
mlastb = case beginDatesFromRawOpts d rawopts of
2016-07-30 05:19:44 +03:00
[] -> Nothing
2019-06-29 23:40:18 +03:00
bs -> Just $ last bs
mlaste = case endDatesFromRawOpts d rawopts of
2016-07-30 05:19:44 +03:00
[] -> Nothing
2019-06-29 23:40:18 +03:00
es -> Just $ last es
2016-07-30 05:19:44 +03:00
-- Get all begin dates specified by -b/--begin or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
beginDatesFromRawOpts :: Day -> RawOpts -> [ Day ]
2019-10-20 02:01:59 +03:00
beginDatesFromRawOpts d = collectopts ( begindatefromrawopt d )
2016-07-30 05:19:44 +03:00
where
begindatefromrawopt d ( n , v )
| n == " begin " =
2018-09-30 04:32:08 +03:00
either ( \ e -> usageError $ " could not parse " ++ n ++ " date: " ++ customErrorBundlePretty e ) Just $
2016-07-30 05:19:44 +03:00
fixSmartDateStrEither' d ( T . pack v )
| n == " period " =
case
2018-09-30 04:32:08 +03:00
either ( \ e -> usageError $ " could not parse period option: " ++ customErrorBundlePretty e ) id $
2016-07-30 05:19:44 +03:00
parsePeriodExpr d ( stripquotes $ T . pack v )
of
( _ , DateSpan ( Just b ) _ ) -> Just b
_ -> Nothing
| otherwise = Nothing
-- Get all end dates specified by -e/--end or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
endDatesFromRawOpts :: Day -> RawOpts -> [ Day ]
2019-10-20 02:01:59 +03:00
endDatesFromRawOpts d = collectopts ( enddatefromrawopt d )
2016-07-30 05:19:44 +03:00
where
enddatefromrawopt d ( n , v )
| n == " end " =
2018-09-30 04:32:08 +03:00
either ( \ e -> usageError $ " could not parse " ++ n ++ " date: " ++ customErrorBundlePretty e ) Just $
2016-07-30 05:19:44 +03:00
fixSmartDateStrEither' d ( T . pack v )
| n == " period " =
case
2018-09-30 04:32:08 +03:00
either ( \ e -> usageError $ " could not parse period option: " ++ customErrorBundlePretty e ) id $
2016-07-30 05:19:44 +03:00
parsePeriodExpr d ( stripquotes $ T . pack v )
of
( _ , DateSpan _ ( Just e ) ) -> Just e
_ -> Nothing
| otherwise = Nothing
-- | Get the report interval, if any, specified by the last of -p/--period,
-- -D/--daily, -W/--weekly, -M/--monthly etc. options.
2019-04-16 22:48:45 +03:00
-- An interval from --period counts only if it is explicitly defined.
2016-07-30 05:19:44 +03:00
intervalFromRawOpts :: RawOpts -> Interval
2019-10-20 02:01:59 +03:00
intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
2016-07-30 05:19:44 +03:00
where
intervalfromrawopt ( n , v )
| n == " period " =
2019-04-16 22:48:45 +03:00
either
( \ e -> usageError $ " could not parse period option: " ++ customErrorBundlePretty e )
extractIntervalOrNothing $
2019-07-25 12:46:45 +03:00
parsePeriodExpr
2020-08-06 02:05:56 +03:00
( error ' " i n t e r v a l F r o m R a w O p t s : d i d n o t e x p e c t t o n e e d t o d a y' s date here " ) -- PARTIAL: should not happen; we are just getting the interval, which does not use the reference date
2019-07-25 12:46:45 +03:00
( stripquotes $ T . pack v )
2016-07-30 05:19:44 +03:00
| n == " daily " = Just $ Days 1
| n == " weekly " = Just $ Weeks 1
| n == " monthly " = Just $ Months 1
| n == " quarterly " = Just $ Quarters 1
| n == " yearly " = Just $ Years 1
| otherwise = Nothing
2019-04-16 22:48:45 +03:00
-- | Extract the interval from the parsed -p/--period expression.
-- Return Nothing if an interval is not explicitly defined.
extractIntervalOrNothing :: ( Interval , DateSpan ) -> Maybe Interval
extractIntervalOrNothing ( NoInterval , _ ) = Nothing
extractIntervalOrNothing ( interval , _ ) = Just interval
2017-06-16 02:54:34 +03:00
-- | 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 ]
2019-10-20 02:01:59 +03:00
statusesFromRawOpts = simplifyStatuses . collectopts statusfromrawopt
2016-07-30 05:19:44 +03:00
where
2017-06-16 02:54:34 +03:00
statusfromrawopt ( n , _ )
2017-06-16 02:25:37 +03:00
| n == " unmarked " = Just Unmarked
2017-06-16 02:54:34 +03:00
| n == " pending " = Just Pending
| n == " cleared " = Just Cleared
2016-07-30 05:19:44 +03:00
| otherwise = Nothing
2017-06-16 02:54:34 +03:00
-- | Reduce a list of statuses to just one of each status,
-- and if all statuses are present return the empty list.
simplifyStatuses l
| length l' >= numstatuses = []
| otherwise = l'
where
2020-01-04 09:09:01 +03:00
l' = nubSort l
2017-06-16 02:54:34 +03:00
numstatuses = length [ minBound .. maxBound :: Status ]
2014-03-26 04:10:30 +04:00
2017-06-16 04:15:37 +03:00
-- | Add/remove this status from the status list. Used by hledger-ui.
reportOptsToggleStatus s ropts @ ReportOpts { statuses_ = ss }
| s ` elem ` ss = ropts { statuses_ = filter ( /= s ) ss }
| otherwise = ropts { statuses_ = simplifyStatuses ( s : ss ) }
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
-- | Parse the type of valuation and costing to be performed, if any,
-- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is
-- allowed to combine -B/--cost with any other valuation type. If
-- there's more than one valuation type, the rightmost flag wins.
2021-08-04 07:29:58 +03:00
-- 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.
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
valuationTypeFromRawOpts :: RawOpts -> ( Costing , Maybe ValuationType )
2021-07-23 08:35:26 +03:00
valuationTypeFromRawOpts rawopts = case ( balancecalcopt rawopts , directcost , directval ) of
( CalcValueChange , _ , Nothing ) -> ( directcost , Just $ AtEnd Nothing ) -- If no valuation requested for valuechange, use AtEnd
( CalcValueChange , _ , Just ( AtEnd _ ) ) -> ( directcost , directval ) -- If AtEnd valuation requested, use it
( CalcValueChange , _ , _ ) -> usageError " --valuechange only produces sensible results with --value=end "
( CalcGain , Cost , _ ) -> usageError " --gain cannot be combined with --cost "
( CalcGain , NoCost , Nothing ) -> ( directcost , Just $ AtEnd Nothing ) -- If no valuation requested for gain, use AtEnd
( _ , _ , _ ) -> ( directcost , directval ) -- Otherwise, use requested valuation
2019-04-26 03:51:51 +03:00
where
2021-08-23 10:14:14 +03:00
directcost = if Cost ` elem ` map fst valuationopts then Cost else NoCost
2021-07-23 08:35:26 +03:00
directval = lastMay $ mapMaybe snd valuationopts
2021-03-05 09:23:07 +03:00
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
valuationopts = collectopts valuationfromrawopt rawopts
2019-06-02 00:54:34 +03:00
valuationfromrawopt ( n , v ) -- option name, value
2021-03-09 18:37:52 +03:00
| n == " B " = Just ( Cost , Nothing ) -- keep supporting --value=cost for now
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
| n == " V " = Just ( NoCost , Just $ AtEnd Nothing )
| n == " X " = Just ( NoCost , Just $ AtEnd ( Just $ T . pack v ) )
2021-03-05 09:23:07 +03:00
| n == " value " = Just $ valueopt v
2019-05-23 10:36:16 +03:00
| otherwise = Nothing
2021-03-05 09:23:07 +03:00
valueopt v
2021-03-10 04:42:01 +03:00
| t ` elem ` [ " cost " , " c " ] = ( Cost , AtEnd . Just <$> mc ) -- keep supporting --value=cost,COMM for now
lib,cli,ui: Separate costing from valuation; each can now be specified
independently.
You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.
If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.
--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
2021-01-26 05:13:11 +03:00
| t ` elem ` [ " then " , " t " ] = ( NoCost , Just $ AtThen mc )
| t ` elem ` [ " end " , " e " ] = ( NoCost , Just $ AtEnd mc )
| t ` elem ` [ " now " , " n " ] = ( NoCost , Just $ AtNow mc )
| otherwise = case parsedateM t of
Just d -> ( NoCost , Just $ AtDate d mc )
Nothing -> usageError $ " could not parse \ " " ++ t ++ " \ " as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD "
2019-06-02 00:54:34 +03:00
where
2019-06-02 02:12:20 +03:00
-- parse --value's value: TYPE[,COMM]
2019-06-02 00:54:34 +03:00
( t , c' ) = break ( == ',' ) v
mc = case drop 1 c' of
" " -> Nothing
c -> Just $ T . pack c
2019-04-26 03:51:51 +03:00
2016-07-30 05:19:44 +03:00
-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> ( Transaction -> Day )
transactionDateFn ReportOpts { .. } = if date2_ then transactionDate2 else tdate
-- | Select the Posting date accessor based on --date2.
postingDateFn :: ReportOpts -> ( Posting -> Day )
postingDateFn ReportOpts { .. } = if date2_ then postingDate2 else postingDate
-- | Report which date we will report on based on --date2.
2021-10-10 22:27:09 +03:00
whichDate :: ReportOpts -> WhichDate
whichDate ReportOpts { .. } = if date2_ then SecondaryDate else PrimaryDate
2014-03-20 04:11:48 +04:00
2014-12-05 23:56:33 +03:00
-- | Legacy-compatible convenience aliases for accountlistmode_.
tree_ :: ReportOpts -> Bool
2020-07-07 08:04:39 +03:00
tree_ ReportOpts { accountlistmode_ = ALTree } = True
tree_ ReportOpts { accountlistmode_ = ALFlat } = False
2014-12-05 23:56:33 +03:00
flat_ :: ReportOpts -> Bool
2020-07-07 08:04:39 +03:00
flat_ = not . tree_
2014-12-05 23:56:33 +03:00
2014-03-20 04:11:48 +04:00
-- depthFromOpts :: ReportOpts -> Int
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
2021-09-23 09:02:09 +03:00
-- | 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 rspec j = journalValueAndFilterPostingsWith rspec j priceoracle
where priceoracle = journalPriceOracle ( infer_prices_ $ _rsReportOpts rspec ) j
-- | Like 'journalValueAndFilterPostings', but takes a 'PriceOracle' as an argument.
journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith rspec @ ReportSpec { _rsQuery = q , _rsReportOpts = ropts } j =
-- Filter by the remainder of the query
filterJournal reportq
-- Apply valuation and costing
. journalApplyValuationFromOptsWith rspec
-- Filter by amount and currency, so it matches pre-valuation/costing
( if queryIsNull amtsymq then j else filterJournalAmounts amtsymq j )
where
-- with -r, replace each posting with its sibling postings
filterJournal = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings
amtsymq = dbg3 " amtsymq " $ filterQuery queryIsAmtOrSym q
reportq = dbg3 " reportq " $ filterQuery ( not . queryIsAmtOrSym ) q
queryIsAmtOrSym = liftA2 ( || ) queryIsAmt queryIsSym
2021-05-13 14:00:25 +03:00
-- | 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.
2021-05-13 12:00:43 +03:00
journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts rspec j =
journalApplyValuationFromOptsWith rspec j priceoracle
2021-09-10 01:17:34 +03:00
where priceoracle = journalPriceOracle ( infer_prices_ $ _rsReportOpts rspec ) j
2021-05-13 12:00:43 +03:00
-- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument.
journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
2021-07-23 09:47:48 +03:00
journalApplyValuationFromOptsWith rspec @ ReportSpec { _rsReportOpts = ropts } j priceoracle =
2021-07-23 08:35:26 +03:00
case balancecalc_ ropts of
CalcGain -> journalMapPostings ( \ p -> postingTransformAmount ( gain p ) p ) j
_ -> journalMapPostings ( \ p -> postingTransformAmount ( valuation p ) p ) $ costing j
2021-05-13 12:00:43 +03:00
where
2021-07-23 08:35:26 +03:00
valuation p = maybe id ( mixedAmountApplyValuation priceoracle styles ( periodEnd p ) ( _rsDay rspec ) ( postingDate p ) ) ( value_ ropts )
gain p = maybe id ( mixedAmountApplyGain priceoracle styles ( periodEnd p ) ( _rsDay rspec ) ( postingDate p ) ) ( value_ ropts )
2021-05-13 12:00:43 +03:00
costing = case cost_ ropts of
Cost -> journalToCost
NoCost -> id
-- Find the end of the period containing this posting
periodEnd = addDays ( - 1 ) . fromMaybe err . mPeriodEnd . postingDate
2021-09-23 08:28:46 +03:00
mPeriodEnd = case interval_ ropts of
NoInterval -> const . spanEnd $ reportSpan j rspec
_ -> spanEnd <=< latestSpanContaining ( historical : spans )
2021-05-13 12:00:43 +03:00
historical = DateSpan Nothing $ spanStart =<< headMay spans
spans = splitSpan ( interval_ ropts ) $ reportSpanBothDates j rspec
styles = journalCommodityStyles j
2021-05-13 13:48:31 +03:00
err = error " journalApplyValuationFromOpts: expected all spans to have an end date "
2021-05-13 14:00:25 +03:00
-- | 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
-> ( DateSpan -> MixedAmount -> MixedAmount )
mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
case valuationAfterSum ropts of
2021-07-23 08:35:26 +03:00
Just mc -> case balancecalc_ ropts of
2021-08-23 10:14:14 +03:00
CalcGain -> gain mc
_ -> \ span -> valuation mc span . costing
Nothing -> const id
2021-05-13 13:48:31 +03:00
where
valuation mc span = mixedAmountValueAtDate priceoracle styles mc ( maybe err ( addDays ( - 1 ) ) $ spanEnd span )
2021-07-23 08:35:26 +03:00
gain mc span = mixedAmountGainAtDate priceoracle styles mc ( maybe err ( addDays ( - 1 ) ) $ spanEnd span )
2021-05-13 13:48:31 +03:00
costing = case cost_ ropts of
Cost -> styleMixedAmount styles . mixedAmountCost
NoCost -> id
styles = journalCommodityStyles j
2021-07-23 08:35:26 +03:00
err = error " mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date "
2021-05-13 12:00:43 +03:00
2021-05-13 14:00:25 +03:00
-- | If the ReportOpts specify that we are performing valuation after summing amounts,
2021-07-23 08:35:26 +03:00
-- return Just of the commodity symbol we're converting to, Just Nothing for the default,
-- and otherwise return Nothing.
2021-05-13 13:48:31 +03:00
-- Used for example with historical reports with --value=end.
valuationAfterSum :: ReportOpts -> Maybe ( Maybe CommoditySymbol )
2021-05-13 12:00:43 +03:00
valuationAfterSum ropts = case value_ ropts of
2021-05-13 14:00:25 +03:00
Just ( AtEnd mc ) | valueAfterSum -> Just mc
_ -> Nothing
2021-07-15 02:28:43 +03:00
where valueAfterSum = balancecalc_ ropts == CalcValueChange
2021-07-23 08:35:26 +03:00
|| balancecalc_ ropts == CalcGain
2021-07-15 02:28:43 +03:00
|| balanceaccum_ ropts /= PerPeriod
2021-05-13 12:00:43 +03:00
2014-03-20 04:11:48 +04:00
-- | Convert report options to a query, ignoring any non-flag command line arguments.
2020-09-02 14:00:45 +03:00
queryFromFlags :: ReportOpts -> Query
queryFromFlags ReportOpts { .. } = simplifyQuery $ And flagsq
2014-03-20 04:11:48 +04:00
where
2020-07-02 06:47:59 +03:00
flagsq = consIf Real real_
. consJust Depth depth_
$ [ ( if date2_ then Date2 else Date ) $ periodAsDateSpan period_
, Or $ map StatusQ statuses_
]
consIf f b = if b then ( f True : ) else id
consJust f = maybe id ( ( : ) . f )
2014-03-20 04:11:48 +04:00
2019-05-06 03:47:38 +03:00
-- Report dates.
2018-03-30 02:16:35 +03:00
-- | The effective report span is the start and end dates specified by
2019-07-15 13:28:52 +03:00
-- options or queries, or otherwise the earliest and latest transaction or
2018-03-30 02:16:35 +03:00
-- posting dates in the journal. If no dates are specified by options/queries
-- and the journal is empty, returns the null date span.
2020-09-16 04:45:52 +03:00
reportSpan :: Journal -> ReportSpec -> DateSpan
2021-03-02 13:32:52 +03:00
reportSpan = reportSpanHelper False
-- | Like reportSpan, but uses both primary and secondary dates when calculating
-- the span.
reportSpanBothDates :: Journal -> ReportSpec -> DateSpan
reportSpanBothDates = reportSpanHelper True
-- | A helper for reportSpan, which takes a Bool indicating whether to use both
-- primary and secondary dates.
reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan
2021-07-23 09:47:48 +03:00
reportSpanHelper bothdates j ReportSpec { _rsQuery = query , _rsReportOpts = ropts } = reportspan
2020-09-11 10:16:07 +03:00
where
2021-03-02 13:32:52 +03:00
-- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg3 " requestedspan " $ if bothdates then queryDateSpan' query else queryDateSpan ( date2_ ropts ) query
-- If we are requesting period-end valuation, the journal date span should
-- include price directives after the last transaction
journalspan = dbg3 " journalspan " $ if bothdates then journalDateSpanBothDates j else journalDateSpan ( date2_ ropts ) j
pricespan = dbg3 " pricespan " . DateSpan Nothing $ case value_ ropts of
Just ( AtEnd _ ) -> fmap ( addDays 1 ) . maximumMay . map pddate $ jpricedirectives j
_ -> Nothing
-- If the requested span is open-ended, close it using the journal's start and end dates.
-- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg3 " requestedspan' " $ requestedspan ` spanDefaultsFrom ` ( journalspan ` spanUnion ` pricespan )
-- The list of interval spans enclosing the requested span.
-- This list can be empty if the journal was empty,
-- or if hledger-ui has added its special date:-tomorrow to the query
-- and all txns are in the future.
intervalspans = dbg3 " intervalspans " $ splitSpan ( interval_ ropts ) requestedspan'
-- The requested span enlarged to enclose a whole number of intervals.
-- This can be the null span if there were no intervals.
reportspan = dbg3 " reportspan " $ DateSpan ( spanStart =<< headMay intervalspans )
( spanEnd =<< lastMay intervalspans )
2020-09-11 10:16:07 +03:00
2020-09-16 04:45:52 +03:00
reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate j = spanStart . reportSpan j
2020-09-11 10:16:07 +03:00
2020-09-16 04:45:52 +03:00
reportEndDate :: Journal -> ReportSpec -> Maybe Day
reportEndDate j = spanEnd . reportSpan j
2016-12-30 22:44:01 +03:00
2019-05-06 03:47:38 +03:00
-- 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.
2020-09-16 04:45:52 +03:00
reportPeriodStart :: ReportSpec -> Maybe Day
2021-07-23 09:47:48 +03:00
reportPeriodStart = queryStartDate False . _rsQuery
2019-05-06 03:47:38 +03:00
-- 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.
2020-09-16 04:45:52 +03:00
reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart rspec j =
reportPeriodStart rspec <|> journalStartDate False j
2019-05-06 03:47:38 +03:00
2019-05-04 22:00:57 +03:00
-- Get the last day of the overall report period.
2019-07-15 13:28:52 +03:00
-- This the inclusive end date (one day before the
2019-05-06 03:47:38 +03:00
-- more commonly used, exclusive, report end date).
2019-05-04 22:00:57 +03:00
-- If no report period is specified, will be Nothing.
2020-09-16 04:45:52 +03:00
reportPeriodLastDay :: ReportSpec -> Maybe Day
2021-07-23 09:47:48 +03:00
reportPeriodLastDay = fmap ( addDays ( - 1 ) ) . queryEndDate False . _rsQuery
2019-05-04 22:00:57 +03:00
2019-05-06 03:47:38 +03:00
-- 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
2021-03-02 13:32:52 +03:00
-- posting date). If we're doing period-end valuation, include price
-- directive dates. If there's no report period and nothing in the
2019-05-06 03:47:38 +03:00
-- journal, will be Nothing.
2020-09-16 04:45:52 +03:00
reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day
2021-03-02 13:32:52 +03:00
reportPeriodOrJournalLastDay rspec j = reportPeriodLastDay rspec <|> journalOrPriceEnd
where
2021-07-23 09:47:48 +03:00
journalOrPriceEnd = case value_ $ _rsReportOpts rspec of
2021-07-12 00:01:01 +03:00
Just ( AtEnd _ ) -> max ( journalLastDay False j ) lastPriceDirective
_ -> journalLastDay False j
2021-03-02 13:32:52 +03:00
lastPriceDirective = fmap ( addDays 1 ) . maximumMay . map pddate $ jpricedirectives j
2021-04-04 02:03:49 +03:00
-- | 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).
2021-07-15 02:28:43 +03:00
reportPeriodName :: BalanceAccumulation -> [ DateSpan ] -> DateSpan -> T . Text
reportPeriodName balanceaccumulation spans =
case balanceaccumulation of
PerPeriod -> if multiyear then showDateSpan else showDateSpanMonthAbbrev
2021-04-04 02:03:49 +03:00
where
multiyear = ( > 1 ) $ length $ nubSort $ map spanStartYear spans
_ -> maybe " " ( showDate . prevday ) . spanEnd
2021-07-27 09:12:02 +03:00
-- 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 _ ( Const x ) = Const x
instance Reportable Identity e where
2021-08-16 09:09:55 +03:00
report a ( Identity i ) = Identity $ fromRight a i
2021-07-27 09:12:02 +03:00
instance Reportable Maybe e where
2021-08-16 07:49:40 +03:00
report _ = ( eitherToMaybe =<< )
2021-07-27 09:12:02 +03:00
instance ( e ~ a ) => Reportable ( Either a ) e where
report _ = join
-- | Apply a function over a lens, but report on failure.
2021-08-25 13:04:44 +03:00
overEither :: ( ( a -> Either e b ) -> s -> Either e t ) -> ( a -> b ) -> s -> Either e t
overEither l f = l ( pure . f )
2021-07-27 09:12:02 +03:00
-- | Set a field using a lens, but report on failure.
2021-08-25 13:04:44 +03:00
setEither :: ( ( a -> Either e b ) -> s -> Either e t ) -> b -> s -> Either e t
setEither l = overEither l . const
2021-07-27 09:12:02 +03:00
type ReportableLens' s a = forall f . Reportable f String => ( a -> f a ) -> s -> f s
-- | Lenses for ReportOpts.
2021-08-25 13:04:44 +03:00
-- 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
2021-07-27 09:12:02 +03:00
-- 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.
2021-08-25 13:04:44 +03:00
--
-- 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 could not be compiled: (assets"
-- >>> _rsQuery $ set querystring ["assets"] defreportspec
-- Acct (RegexpCI "assets")
-- >>> _rsQuery $ set querystring ["(assets"] defreportspec
-- *** Exception: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set
-- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec
-- Date DateSpan 2021-08
class HasReportOptsNoUpdate a => HasReportOpts a where
2021-07-27 09:12:02 +03:00
reportOpts :: ReportableLens' a ReportOpts
2021-08-25 13:04:44 +03:00
reportOpts = reportOptsNoUpdate
{- # INLINE reportOpts # -}
2021-07-27 09:12:02 +03:00
period :: ReportableLens' a Period
2021-08-25 13:04:44 +03:00
period = reportOpts . periodNoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE period # -}
statuses :: ReportableLens' a [ Status ]
2021-08-25 13:04:44 +03:00
statuses = reportOpts . statusesNoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE statuses # -}
depth :: ReportableLens' a ( Maybe Int )
2021-08-25 13:04:44 +03:00
depth = reportOpts . depthNoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE depth # -}
date2 :: ReportableLens' a Bool
2021-08-25 13:04:44 +03:00
date2 = reportOpts . date2NoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE date2 # -}
real :: ReportableLens' a Bool
2021-08-25 13:04:44 +03:00
real = reportOpts . realNoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE real # -}
querystring :: ReportableLens' a [ T . Text ]
2021-08-25 13:04:44 +03:00
querystring = reportOpts . querystringNoUpdate
2021-07-27 09:12:02 +03:00
{- # INLINE querystring # -}
2021-08-25 13:04:44 +03:00
instance HasReportOpts ReportOpts
2021-07-27 09:12:02 +03:00
2021-08-25 13:04:44 +03:00
instance HasReportOptsNoUpdate ReportSpec where
reportOptsNoUpdate = rsReportOpts
2021-07-27 09:12:02 +03:00
2021-08-25 13:04:44 +03:00
instance HasReportOpts ReportSpec where
reportOpts f rspec = report ( error ' " U p d a t i n g R e p o r t S p e c f a i l e d : t r y u s i n g o v e r E i t h e r i n s t e a d o f o v e r o r s e t E i t h e r i n s t e a d o f s e t " ) $ - - P A R T I A L :
reportOptsToSpec ( _rsDay rspec ) <$> f ( _rsReportOpts rspec )
{- # INLINE reportOpts # -}
2021-07-27 09:12:02 +03:00
2021-08-25 13:04:44 +03:00
-- | Generate a ReportSpec from a set of ReportOpts on a given day.
reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec day ropts = do
( argsquery , queryopts ) <- parseQueryList day $ querystring_ ropts
return ReportSpec
{ _rsReportOpts = ropts
, _rsDay = day
, _rsQuery = simplifyQuery $ And [ queryFromFlags ropts , argsquery ]
, _rsQueryOpts = queryopts
}
2021-07-27 09:12:02 +03:00
2021-08-25 13:04:44 +03:00
-- | 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 = setEither reportOpts
2021-07-27 09:12:02 +03:00
2021-08-25 13:04:44 +03:00
-- | Like updateReportSpec, but takes a ReportOpts-modifying function.
updateReportSpecWith :: ( ReportOpts -> ReportOpts ) -> ReportSpec -> Either String ReportSpec
updateReportSpecWith = overEither reportOpts
2021-07-27 09:12:02 +03:00
2021-08-29 17:25:11 +03:00
-- | Generate a ReportSpec from RawOpts and a provided day, or return an error
-- string if there are regular expression errors.
rawOptsToReportSpec :: Day -> RawOpts -> Either String ReportSpec
rawOptsToReportSpec day = reportOptsToSpec day . rawOptsToReportOpts day