{-|

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,
  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 qualified Data.Text as T
import Data.Time.Calendar (Day, addDays)
import Data.Default (Default(..))
import Safe (headMay, 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
parsedateM [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 = 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

-- | Like 'journalValueAndFilterPostings', but takes a 'PriceOracle' as an argument.
journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalValueAndFilterPostingsWith rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
q, _rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j =
    -- Filter by the remainder of the query
      Query -> Journal -> Journal
filterJournal Query
reportq
    -- Apply valuation and costing
    (Journal -> Journal)
-> (PriceOracle -> Journal) -> PriceOracle -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith ReportSpec
rspec
    -- Filter by amount and currency, so it matches pre-valuation/costing
      (if Query -> Bool
queryIsNull Query
amtsymq then Journal
j else Query -> Journal -> Journal
filterJournalAmounts Query
amtsymq Journal
j)
  where
    -- with -r, replace each posting with its sibling postings
    filterJournal :: Query -> Journal -> Journal
filterJournal = if ReportOpts -> Bool
related_ ReportOpts
ropts then Query -> Journal -> Journal
filterJournalRelatedPostings else Query -> Journal -> Journal
filterJournalPostings
    amtsymq :: Query
amtsymq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"amtsymq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAmtOrSym Query
q
    reportq :: Query
reportq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsAmtOrSym) Query
q
    queryIsAmtOrSym :: Query -> Bool
queryIsAmtOrSym = (Bool -> Bool -> Bool)
-> (Query -> Bool) -> (Query -> Bool) -> Query -> Bool
forall a b c.
(a -> b -> c) -> (Query -> a) -> (Query -> b) -> Query -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) Query -> Bool
queryIsAmt Query -> Bool
queryIsSym

-- | 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. Show 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. Show 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 of the period containing this posting
    postingperiodend :: Posting -> Day
postingperiodend  = Year -> Day -> Day
addDays (-Year
1) (Day -> Day) -> (Posting -> Day) -> Posting -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
forall {a}. a
err (Maybe Day -> Day) -> (Posting -> Maybe Day) -> Posting -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Maybe Day
mPeriodEnd (Day -> Maybe Day) -> (Posting -> Day) -> Posting -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhichDate -> Posting -> Day
postingDateOrDate2 (ReportOpts -> WhichDate
whichDate ReportOpts
ropts)
    mPeriodEnd :: Day -> Maybe Day
mPeriodEnd = case ReportOpts -> Interval
interval_ ReportOpts
ropts of
        Interval
NoInterval -> Maybe Day -> Day -> Maybe Day
forall a b. a -> b -> a
const (Maybe Day -> Day -> Maybe Day)
-> ((DateSpan, [DateSpan]) -> Maybe Day)
-> (DateSpan, [DateSpan])
-> Day
-> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day)
-> ((DateSpan, [DateSpan]) -> DateSpan)
-> (DateSpan, [DateSpan])
-> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan, [DateSpan]) -> DateSpan
forall a b. (a, b) -> a
fst ((DateSpan, [DateSpan]) -> Day -> Maybe Day)
-> (DateSpan, [DateSpan]) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan Journal
j ReportSpec
rspec
        Interval
_          -> DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day)
-> (Day -> Maybe DateSpan) -> Day -> Maybe Day
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [DateSpan] -> Day -> Maybe DateSpan
latestSpanContaining (DateSpan
historical DateSpan -> [DateSpan] -> [DateSpan]
forall a. a -> [a] -> [a]
: [DateSpan]
spans)
    historical :: DateSpan
historical = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
forall a. Maybe a
Nothing (Maybe EFDay -> DateSpan) -> Maybe EFDay -> DateSpan
forall a b. (a -> b) -> a -> b
$ ((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 (Maybe Day -> Maybe EFDay)
-> (DateSpan -> Maybe Day) -> DateSpan -> Maybe EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanStart) (DateSpan -> Maybe EFDay) -> Maybe DateSpan -> Maybe EFDay
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
headMay [DateSpan]
spans
    spans :: [DateSpan]
spans = (DateSpan, [DateSpan]) -> [DateSpan]
forall a b. (a, b) -> b
snd ((DateSpan, [DateSpan]) -> [DateSpan])
-> (DateSpan, [DateSpan]) -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanBothDates Journal
j ReportSpec
rspec
    styles :: Map Text AmountStyle
styles = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"journalApplyValuationFromOpts: expected all spans to have an end date"

-- | 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 :: ReportOpts
-> Journal -> PriceOracle -> DateSpan -> 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 -> DateSpan -> MixedAmount -> MixedAmount
gain Maybe Text
mc
            BalanceCalculation
_        -> \DateSpan
spn -> Maybe Text -> DateSpan -> MixedAmount -> MixedAmount
valuation Maybe Text
mc DateSpan
spn (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)
-> DateSpan -> MixedAmount -> MixedAmount
forall a b. a -> b -> a
const MixedAmount -> MixedAmount
forall a. a -> a
id
  where
    valuation :: Maybe Text -> DateSpan -> MixedAmount -> MixedAmount
valuation Maybe Text
mc DateSpan
spn = PriceOracle
-> Map Text AmountStyle
-> Maybe Text
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountValueAtDate PriceOracle
priceoracle Map Text AmountStyle
styles Maybe Text
mc (Day -> (Day -> Day) -> Maybe Day -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Day
forall {a}. a
err (Year -> Day -> Day
addDays (-Year
1)) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanEnd DateSpan
spn)
    gain :: Maybe Text -> DateSpan -> MixedAmount -> MixedAmount
gain Maybe Text
mc DateSpan
spn = PriceOracle
-> Map Text AmountStyle
-> Maybe Text
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountGainAtDate PriceOracle
priceoracle Map Text AmountStyle
styles Maybe Text
mc (Day -> (Day -> Day) -> Maybe Day -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Day
forall {a}. a
err (Year -> Day -> Day
addDays (-Year
1)) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanEnd DateSpan
spn)
    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
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"

-- | 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) | Bool
valueAfterSum -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
mc
    Maybe ValuationType
_                               -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
  where valueAfterSum :: Bool
valueAfterSum = ReportOpts -> BalanceCalculation
balancecalc_  ReportOpts
ropts BalanceCalculation -> BalanceCalculation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceCalculation
CalcValueChange
                     Bool -> Bool -> Bool
|| ReportOpts -> BalanceCalculation
balancecalc_  ReportOpts
ropts BalanceCalculation -> BalanceCalculation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceCalculation
CalcGain
                     Bool -> Bool -> Bool
|| ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts BalanceAccumulation -> BalanceAccumulation -> Bool
forall a. Eq a => a -> a -> Bool
/= BalanceAccumulation
PerPeriod


-- | 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
Truea -> [a] -> [a]
forall a. a -> [a] -> [a]
:) 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 specified by
-- options or queries, or otherwise the earliest and latest transaction or
-- posting dates in the journal. If no dates are specified by options/queries
-- and the journal is empty, returns the null date span.
-- Also return the intervals if they are requested.
reportSpan :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan = Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanHelper Bool
False

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

-- | A helper for reportSpan, which takes a Bool indicating whether to use both
-- primary and secondary dates.
reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanHelper Bool
bothdates Journal
j ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query, _rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} =
    (DateSpan
reportspan, [DateSpan]
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 we are requesting period-end valuation, the journal date span should
    -- include price directives after the last transaction
    journalspan :: DateSpan
journalspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"journalspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ if Bool
bothdates then Journal -> DateSpan
journalDateSpanBothDates Journal
j else Bool -> Journal -> DateSpan
journalDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) Journal
j
    pricespan :: DateSpan
pricespan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"pricespan" (DateSpan -> DateSpan)
-> (Maybe EFDay -> DateSpan) -> Maybe EFDay -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
forall a. Maybe a
Nothing (Maybe EFDay -> DateSpan) -> Maybe EFDay -> DateSpan
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
        Just (AtEnd Maybe Text
_) -> (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
. (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
        Maybe ValuationType
_              -> Maybe EFDay
forall a. Maybe a
Nothing
    -- If the requested span is open-ended, close it using the journal's start and end dates.
    -- This can still be the null (open) span if the journal is empty.
    requestedspan' :: DateSpan
requestedspan' = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"requestedspan'" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
requestedspan DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` (DateSpan
journalspan DateSpan -> DateSpan -> DateSpan
`spanExtend` DateSpan
pricespan)
    -- The list of interval spans enclosing the requested span.
    -- This list can be empty if the journal was empty,
    -- or if hledger-ui has added its special date:-tomorrow to the query
    -- and all txns are in the future.
    intervalspans :: [DateSpan]
intervalspans  = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"intervalspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Bool -> Interval -> DateSpan -> [DateSpan]
splitSpan Bool
adjust (ReportOpts -> Interval
interval_ ReportOpts
ropts) DateSpan
requestedspan'
      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.
    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
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan ((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 (Maybe Day -> Maybe EFDay)
-> (DateSpan -> Maybe Day) -> DateSpan -> Maybe EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe EFDay) -> Maybe DateSpan -> Maybe EFDay
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
headMay [DateSpan]
intervalspans)
                                              ((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 (Maybe Day -> Maybe EFDay)
-> (DateSpan -> Maybe Day) -> DateSpan -> Maybe EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe EFDay) -> Maybe DateSpan -> Maybe EFDay
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
lastMay [DateSpan]
intervalspans)

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

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

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

-- Get the report's start date.
-- If no report period is specified, will be Nothing.
reportPeriodStart :: ReportSpec -> Maybe Day
reportPeriodStart :: ReportSpec -> Maybe Day
reportPeriodStart = Bool -> Query -> Maybe Day
queryStartDate Bool
False (Query -> Maybe Day)
-> (ReportSpec -> Query) -> ReportSpec -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> Query
_rsQuery

-- Get the report's start date, or if no report period is specified,
-- the journal's start date (the earliest posting date). If there's no
-- report period and nothing in the journal, will be Nothing.
reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart ReportSpec
rspec Journal
j =
  ReportSpec -> Maybe Day
reportPeriodStart ReportSpec
rspec Maybe Day -> Maybe Day -> Maybe Day
forall 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 (Either e a -> Maybe a) -> Maybe (Either e a) -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

instance (e ~ a) => Reportable (Either a) e where
    report :: forall a. a -> Either a (Either e a) -> Either a a
report a
_ = Either a (Either e a) -> Either a a
Either a (Either a 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