{-| Options common to most hledger reports. -} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Hledger.Reports.ReportOptions ( ReportOpts(..), ReportSpec(..), ReportType(..), BalanceType(..), AccountListMode(..), ValuationType(..), defreportopts, rawOptsToReportOpts, defreportspec, reportOptsToSpec, updateReportSpec, updateReportSpecWith, rawOptsToReportSpec, balanceTypeOverride, flat_, tree_, reportOptsToggleStatus, simplifyStatuses, whichDateFromOpts, journalSelectingAmountFromOpts, intervalFromRawOpts, forecastPeriodFromRawOpts, queryFromFlags, transactionDateFn, postingDateFn, reportSpan, reportSpanBothDates, reportStartDate, reportEndDate, reportPeriodStart, reportPeriodOrJournalStart, reportPeriodLastDay, reportPeriodOrJournalLastDay, ) where import Control.Applicative ((<|>)) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) import Safe (headMay, lastDef, lastMay, maximumMay) import System.Console.ANSI (hSupportsANSIColor) import System.Environment (lookupEnv) import System.IO (stdout) import Text.Megaparsec.Custom import Hledger.Data import Hledger.Query import Hledger.Utils -- | What is calculated and shown in each cell in a balance report. data ReportType = ChangeReport -- ^ The sum of posting amounts. | BudgetReport -- ^ The sum of posting amounts and the goal. | ValueChangeReport -- ^ The change of value of period-end historical values. deriving (Eq, Show) instance Default ReportType where def = ChangeReport -- | Which "accumulation method" is being shown in a balance report. data BalanceType = PeriodChange -- ^ The accumulate change over a single period. | CumulativeChange -- ^ The accumulated change across multiple periods. | HistoricalBalance -- ^ The historical ending balance, including the effect of -- all postings before the report period. Unless altered by, -- a query, this is what you would see on a bank statement. deriving (Eq,Show) instance Default BalanceType where def = PeriodChange -- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ? data AccountListMode = ALFlat | ALTree deriving (Eq, Show) instance Default AccountListMode where def = ALFlat -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options -- or query arguments, but not all. Some are used only by certain -- commands, as noted below. data ReportOpts = ReportOpts { -- for most reports: period_ :: Period ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,cost_ :: Costing -- ^ Should we convert amounts to cost, when present? ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,infer_value_ :: Bool -- ^ Infer market prices from transactions ? ,depth_ :: Maybe Int ,date2_ :: Bool ,empty_ :: Bool ,no_elide_ :: Bool ,real_ :: Bool ,format_ :: StringFormat ,querystring_ :: [T.Text] -- ,average_ :: Bool -- for posting reports (register) ,related_ :: Bool -- for account transactions reports (aregister) ,txn_dates_ :: Bool -- for balance reports (bal, bs, cf, is) ,reporttype_ :: ReportType ,balancetype_ :: BalanceType ,accountlistmode_ :: AccountListMode ,drop_ :: Int ,row_total_ :: Bool ,no_total_ :: Bool ,pretty_tables_ :: Bool ,sort_amount_ :: Bool ,percent_ :: Bool ,invert_ :: Bool -- ^ if true, flip all amount signs in reports ,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. ,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. ,forecast_ :: Maybe DateSpan ,transpose_ :: Bool } deriving (Show) instance Default ReportOpts where def = defreportopts defreportopts :: ReportOpts defreportopts = ReportOpts { period_ = PeriodAll , interval_ = NoInterval , statuses_ = [] , cost_ = NoCost , value_ = Nothing , infer_value_ = False , depth_ = Nothing , date2_ = False , empty_ = False , no_elide_ = False , real_ = False , format_ = def , querystring_ = [] , average_ = False , related_ = False , txn_dates_ = False , reporttype_ = def , balancetype_ = def , accountlistmode_ = ALFlat , drop_ = 0 , row_total_ = False , no_total_ = False , pretty_tables_ = False , sort_amount_ = False , percent_ = False , invert_ = False , normalbalance_ = Nothing , color_ = False , forecast_ = Nothing , transpose_ = False } rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do d <- getCurrentDay no_color <- isJust <$> lookupEnv "NO_COLOR" supports_color <- hSupportsANSIColor stdout let colorflag = stringopt "color" rawopts formatstring = T.pack <$> maybestringopt "format" rawopts querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right (costing, valuation) = valuationTypeFromRawOpts rawopts format <- case parseStringFormat <$> formatstring of Nothing -> return defaultBalanceLineFormat Just (Right x) -> return x Just (Left err) -> fail $ "could not parse format option: " ++ err return defreportopts {period_ = periodFromRawOpts d rawopts ,interval_ = intervalFromRawOpts rawopts ,statuses_ = statusesFromRawOpts rawopts ,cost_ = costing ,value_ = valuation ,infer_value_ = boolopt "infer-market-price" rawopts ,depth_ = maybeposintopt "depth" rawopts ,date2_ = boolopt "date2" rawopts ,empty_ = boolopt "empty" rawopts ,no_elide_ = boolopt "no-elide" rawopts ,real_ = boolopt "real" rawopts ,format_ = format ,querystring_ = querystring ,average_ = boolopt "average" rawopts ,related_ = boolopt "related" rawopts ,txn_dates_ = boolopt "txn-dates" rawopts ,reporttype_ = reporttypeopt rawopts ,balancetype_ = balancetypeopt rawopts ,accountlistmode_ = accountlistmodeopt rawopts ,drop_ = posintopt "drop" rawopts ,row_total_ = boolopt "row-total" rawopts ,no_total_ = boolopt "no-total" rawopts ,sort_amount_ = boolopt "sort-amount" rawopts ,percent_ = boolopt "percent" rawopts ,invert_ = boolopt "invert" rawopts ,pretty_tables_ = boolopt "pretty-tables" rawopts ,color_ = and [not no_color ,not $ colorflag `elem` ["never","no"] ,colorflag `elem` ["always","yes"] || supports_color ] ,forecast_ = forecastPeriodFromRawOpts d rawopts ,transpose_ = boolopt "transpose" rawopts } -- | The result of successfully parsing a ReportOpts on a particular -- Day. Any ambiguous dates are completed and Queries are parsed, -- ensuring that there are no regular expression errors. Values here -- should be used in preference to re-deriving them from ReportOpts. -- If you change the query_ in ReportOpts, you should call -- `reportOptsToSpec` to regenerate the ReportSpec with the new -- Query. data ReportSpec = ReportSpec { rsOpts :: ReportOpts -- ^ The underlying ReportOpts used to generate this ReportSpec , rsToday :: Day -- ^ The Day this ReportSpec is generated for , rsQuery :: Query -- ^ The generated Query for the given day , rsQueryOpts :: [QueryOpt] -- ^ A list of QueryOpts for the given day } deriving (Show) instance Default ReportSpec where def = defreportspec defreportspec :: ReportSpec defreportspec = ReportSpec { rsOpts = def , rsToday = nulldate , rsQuery = Any , rsQueryOpts = [] } -- | Generate a ReportSpec from a set of ReportOpts on a given day. reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec reportOptsToSpec day ropts = do (argsquery, queryopts) <- parseQueryList day $ querystring_ ropts return ReportSpec { rsOpts = ropts , rsToday = day , rsQuery = simplifyQuery $ And [queryFromFlags ropts, argsquery] , rsQueryOpts = queryopts } -- | Update the ReportOpts and the fields derived from it in a ReportSpec, -- or return an error message if there is a problem such as missing or -- unparseable options data. This is the safe way to change a ReportSpec, -- ensuring that all fields (rsQuery, rsOpts, querystring_, etc.) are in sync. updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec updateReportSpec ropts rspec = reportOptsToSpec (rsToday rspec) ropts -- | Like updateReportSpec, but takes a ReportOpts-modifying function. updateReportSpecWith :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec updateReportSpecWith f rspec = reportOptsToSpec (rsToday rspec) . f $ rsOpts rspec -- | Generate a ReportSpec from RawOpts and the current date. rawOptsToReportSpec :: RawOpts -> IO ReportSpec rawOptsToReportSpec rawopts = do d <- getCurrentDay ropts <- rawOptsToReportOpts rawopts either fail return $ reportOptsToSpec d ropts accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = fromMaybe ALFlat . choiceopt parse where parse = \case "tree" -> Just ALTree "flat" -> Just ALFlat _ -> Nothing reporttypeopt :: RawOpts -> ReportType reporttypeopt = fromMaybe ChangeReport . choiceopt parse where parse = \case "sum" -> Just ChangeReport "valuechange" -> Just ValueChangeReport "budget" -> Just BudgetReport _ -> Nothing balancetypeopt :: RawOpts -> BalanceType balancetypeopt = fromMaybe PeriodChange . balanceTypeOverride balanceTypeOverride :: RawOpts -> Maybe BalanceType balanceTypeOverride rawopts = choiceopt parse rawopts <|> reportbal where parse = \case "historical" -> Just HistoricalBalance "cumulative" -> Just CumulativeChange "change" -> Just PeriodChange _ -> Nothing reportbal = case reporttypeopt rawopts of ValueChangeReport -> Just PeriodChange _ -> Nothing -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. -- Its bounds are the rightmost begin date specified by a -b or -p, and -- the rightmost end date specified by a -e or -p. Cf #1011. -- Today's date is provided to help interpret any relative dates. periodFromRawOpts :: Day -> RawOpts -> Period periodFromRawOpts d rawopts = case (mlastb, mlaste) of (Nothing, Nothing) -> PeriodAll (Just b, Nothing) -> PeriodFrom b (Nothing, Just e) -> PeriodTo e (Just b, Just e) -> simplifyPeriod $ PeriodBetween b e where mlastb = case beginDatesFromRawOpts d rawopts of [] -> Nothing bs -> Just $ last bs mlaste = case endDatesFromRawOpts d rawopts of [] -> Nothing es -> Just $ last es -- Get all begin dates specified by -b/--begin or -p/--period options, in order, -- using the given date to interpret relative date expressions. beginDatesFromRawOpts :: Day -> RawOpts -> [Day] beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) where begindatefromrawopt d (n,v) | n == "begin" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan (Just b) _) -> Just b _ -> Nothing | otherwise = Nothing -- Get all end dates specified by -e/--end or -p/--period options, in order, -- using the given date to interpret relative date expressions. endDatesFromRawOpts :: Day -> RawOpts -> [Day] endDatesFromRawOpts d = collectopts (enddatefromrawopt d) where enddatefromrawopt d (n,v) | n == "end" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan _ (Just e)) -> Just e _ -> Nothing | otherwise = Nothing -- | Get the report interval, if any, specified by the last of -p/--period, -- -D/--daily, -W/--weekly, -M/--monthly etc. options. -- An interval from --period counts only if it is explicitly defined. intervalFromRawOpts :: RawOpts -> Interval intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt where intervalfromrawopt (n,v) | n == "period" = either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) extractIntervalOrNothing $ parsePeriodExpr (error' "intervalFromRawOpts: did not expect to need today's date here") -- PARTIAL: should not happen; we are just getting the interval, which does not use the reference date (stripquotes $ T.pack v) | n == "daily" = Just $ Days 1 | n == "weekly" = Just $ Weeks 1 | n == "monthly" = Just $ Months 1 | n == "quarterly" = Just $ Quarters 1 | n == "yearly" = Just $ Years 1 | otherwise = Nothing -- | get period expression from --forecast option forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan forecastPeriodFromRawOpts d opts = case maybestringopt "forecast" opts of Nothing -> Nothing Just "" -> Just nulldatespan Just str -> either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $ parsePeriodExpr d $ stripquotes $ T.pack str -- | Extract the interval from the parsed -p/--period expression. -- Return Nothing if an interval is not explicitly defined. extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval extractIntervalOrNothing (NoInterval, _) = Nothing extractIntervalOrNothing (interval, _) = Just 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 = simplifyStatuses . collectopts statusfromrawopt where statusfromrawopt (n,_) | n == "unmarked" = Just Unmarked | n == "pending" = Just Pending | n == "cleared" = Just Cleared | otherwise = Nothing -- | Reduce a list of statuses to just one of each status, -- and if all statuses are present return the empty list. simplifyStatuses l | length l' >= numstatuses = [] | otherwise = l' where l' = nubSort l numstatuses = length [minBound .. maxBound :: Status] -- | Add/remove this status from the status list. Used by hledger-ui. reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} | s `elem` ss = ropts{statuses_=filter (/= s) ss} | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} -- | Parse the type of valuation and costing to be performed, if any, -- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is -- allowed to combine -B/--cost with any other valuation type. If -- there's more than one valuation type, the rightmost flag wins. valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType) valuationTypeFromRawOpts rawopts = (costing, valuation) where costing = if (any ((Cost==) . fst) valuationopts) then Cost else NoCost valuation = case reporttypeopt rawopts of ValueChangeReport -> case directval of Nothing -> Just $ AtEnd Nothing -- If no valuation requested for valuechange, use AtEnd Just (AtEnd _) -> directval -- If AtEnd valuation requested, use it Just _ -> usageError "--valuechange only produces sensible results with --value=end" _ -> directval -- Otherwise, use requested valuation where directval = lastMay $ mapMaybe snd valuationopts valuationopts = collectopts valuationfromrawopt rawopts valuationfromrawopt (n,v) -- option name, value | n == "B" = Just (Cost, Nothing) -- keep supporting --value=cost for now | n == "V" = Just (NoCost, Just $ AtEnd Nothing) | n == "X" = Just (NoCost, Just $ AtEnd (Just $ T.pack v)) | n == "value" = Just $ valueopt v | otherwise = Nothing valueopt v | t `elem` ["cost","c"] = (Cost, AtEnd . Just <$> mc) -- keep supporting --value=cost,COMM for now | t `elem` ["then" ,"t"] = (NoCost, Just $ AtThen mc) | t `elem` ["end" ,"e"] = (NoCost, Just $ AtEnd mc) | t `elem` ["now" ,"n"] = (NoCost, Just $ AtNow mc) | otherwise = case parsedateM t of Just d -> (NoCost, Just $ AtDate d mc) Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD" where -- parse --value's value: TYPE[,COMM] (t,c') = break (==',') v mc = case drop 1 c' of "" -> Nothing c -> Just $ T.pack c -- | Select the Transaction date accessor based on --date2. transactionDateFn :: ReportOpts -> (Transaction -> Day) transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate -- | Select the Posting date accessor based on --date2. postingDateFn :: ReportOpts -> (Posting -> Day) postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate -- | Report which date we will report on based on --date2. whichDateFromOpts :: ReportOpts -> WhichDate whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate -- | Legacy-compatible convenience aliases for accountlistmode_. tree_ :: ReportOpts -> Bool tree_ ReportOpts{accountlistmode_ = ALTree} = True tree_ ReportOpts{accountlistmode_ = ALFlat} = False flat_ :: ReportOpts -> Bool flat_ = not . tree_ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- | Convert this journal's postings' amounts to cost using their -- transaction prices, if specified by options (-B/--cost). -- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal journalSelectingAmountFromOpts opts = case cost_ opts of Cost -> journalToCost NoCost -> id -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromFlags :: ReportOpts -> Query queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq where flagsq = consIf Real real_ . consJust Depth depth_ $ [ (if date2_ then Date2 else Date) $ periodAsDateSpan period_ , Or $ map StatusQ statuses_ ] consIf f b = if b then (f True:) else id consJust f = maybe id ((:) . f) -- Report dates. -- | The effective report span is the start and end dates specified by -- options or queries, or otherwise the earliest and latest transaction or -- posting dates in the journal. If no dates are specified by options/queries -- and the journal is empty, returns the null date span. -- The boolean argument flags whether primary and secondary dates are considered -- equivalently. reportSpan :: Journal -> ReportSpec -> DateSpan reportSpan = reportSpanHelper False -- | Like reportSpan, but uses both primary and secondary dates when calculating -- the span. reportSpanBothDates :: Journal -> ReportSpec -> DateSpan reportSpanBothDates = reportSpanHelper True -- | A helper for reportSpan, which takes a Bool indicating whether to use both -- primary and secondary dates. reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan reportSpanHelper bothdates j ReportSpec{rsQuery=query, rsOpts=ropts} = reportspan where -- The date span specified by -b/-e/-p options and query args if any. requestedspan = dbg3 "requestedspan" $ if bothdates then queryDateSpan' query else queryDateSpan (date2_ ropts) query -- If we are requesting period-end valuation, the journal date span should -- include price directives after the last transaction journalspan = dbg3 "journalspan" $ if bothdates then journalDateSpanBothDates j else journalDateSpan (date2_ ropts) j pricespan = dbg3 "pricespan" . DateSpan Nothing $ case value_ ropts of Just (AtEnd _) -> fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j _ -> Nothing -- If the requested span is open-ended, close it using the journal's start and end dates. -- This can still be the null (open) span if the journal is empty. requestedspan' = dbg3 "requestedspan'" $ requestedspan `spanDefaultsFrom` (journalspan `spanUnion` pricespan) -- The list of interval spans enclosing the requested span. -- This list can be empty if the journal was empty, -- or if hledger-ui has added its special date:-tomorrow to the query -- and all txns are in the future. intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspan' -- The requested span enlarged to enclose a whole number of intervals. -- This can be the null span if there were no intervals. reportspan = dbg3 "reportspan" $ DateSpan (spanStart =<< headMay intervalspans) (spanEnd =<< lastMay intervalspans) reportStartDate :: Journal -> ReportSpec -> Maybe Day reportStartDate j = spanStart . reportSpan j reportEndDate :: Journal -> ReportSpec -> Maybe Day reportEndDate j = spanEnd . reportSpan 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 = queryStartDate False . 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 rspec j = reportPeriodStart rspec <|> journalStartDate False 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 = fmap (addDays (-1)) . queryEndDate False . 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 rspec j = reportPeriodLastDay rspec <|> journalOrPriceEnd where journalOrPriceEnd = case value_ $ rsOpts rspec of Just (AtEnd _) -> max (journalEndDate False j) lastPriceDirective _ -> journalEndDate False j lastPriceDirective = fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j