slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ref!: forecast: Move forecast_ from ReportOpts to InputOpts.

Browse Source
This commit is contained in:
Stephen Morgan 2021-08-04 11:55:42 +10:00 committed by Simon Michael
parent 5cca04cdc9
commit c404800fbf
10 changed files with 55 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
hledger-lib/Hledger/Read/Common.hs
View File

@ -32,6 +32,7 @@ module Hledger.Read.Common (
InputOpts (..),
definputopts,
rawOptsToInputOpts,
forecastPeriodFromRawOpts,
-- * parsing utilities
runTextParser,
@ -204,6 +205,7 @@ data InputOpts = InputOpts {
,new_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name
,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions
,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)
@ -220,13 +222,17 @@ definputopts = InputOpts
, new_ = False
, new_save_ = True
, pivot_ = ""
, forecast_ = Nothing
, auto_ = False
, balancingopts_ = def
, strict_ = False
}
rawOptsToInputOpts :: RawOpts -> InputOpts
rawOptsToInputOpts rawopts = InputOpts{
rawOptsToInputOpts :: RawOpts -> IO InputOpts
rawOptsToInputOpts rawopts = do
d <- getCurrentDay
return InputOpts{
-- files_ = listofstringopt "file" rawopts
mformat_ = Nothing
,mrules_file_ = maybestringopt "rules-file" rawopts
@ -235,6 +241,7 @@ rawOptsToInputOpts rawopts = InputOpts{
,new_ = boolopt "new" rawopts
,new_save_ = True
,pivot_ = stringopt "pivot" rawopts
,forecast_ = forecastPeriodFromRawOpts d rawopts
,auto_ = boolopt "auto" rawopts
,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts
, infer_prices_ = not noinferprice
@ -243,6 +250,17 @@ rawOptsToInputOpts rawopts = InputOpts{
}
where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion"
-- | 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
--- ** parsing utilities
-- | Run a text parser in the identity monad. See also: parseWithState.

21
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -42,7 +42,6 @@ module Hledger.Reports.ReportOptions (
mixedAmountApplyValuationAfterSumFromOptsWith,
valuationAfterSum,
intervalFromRawOpts,
forecastPeriodFromRawOpts,
queryFromFlags,
transactionDateFn,
postingDateFn,
@ -156,7 +155,6 @@ data ReportOpts = ReportOpts {
-- 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)
@ -194,7 +192,6 @@ defreportopts = ReportOpts
, invert_ = False
, normalbalance_ = Nothing
, color_ = False
, forecast_ = Nothing
, transpose_ = False
}
@ -241,7 +238,6 @@ rawOptsToReportOpts rawopts = do
,invert_ = boolopt "invert" rawopts
,pretty_tables_ = boolopt "pretty-tables" rawopts
,color_ = useColorOnStdout -- a lower-level helper
,forecast_ = forecastPeriodFromRawOpts d rawopts
,transpose_ = boolopt "transpose" rawopts
}
@ -411,17 +407,6 @@ intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
| 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
@ -838,10 +823,6 @@ class HasReportOpts a where
color__ = reportOptsNoUpdate.color__
{-# INLINE color__ #-}
forecast :: Lens' a (Maybe DateSpan)
forecast = reportOptsNoUpdate.forecast
{-# INLINE forecast #-}
transpose__ :: Lens' a Bool
transpose__ = reportOptsNoUpdate.transpose__
{-# INLINE transpose__ #-}
@ -907,8 +888,6 @@ instance HasReportOpts ReportOpts where
{-# INLINE normalbalance #-}
color__ f ropts = (\x -> ropts{color_=x}) <$> f (color_ ropts)
{-# INLINE color__ #-}
forecast f ropts = (\x -> ropts{forecast_=x}) <$> f (forecast_ ropts)
{-# INLINE forecast #-}
transpose__ f ropts = (\x -> ropts{transpose_=x}) <$> f (transpose_ ropts)
{-# INLINE transpose__ #-}

6
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -49,7 +49,7 @@ accountsScreen = AccountsScreen{
asInit :: Day -> Bool -> UIState -> UIState
asInit d reset ui@UIState{
aopts=UIOpts{cliopts_=CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}},
aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}},
ajournal=j,
aScreen=s@AccountsScreen{}
} =
@ -77,7 +77,7 @@ asInit d reset ui@UIState{
as = map asItemAccountName displayitems
-- Further restrict the query based on the current period and future/forecast mode.
rspec' = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq (forecast_ ropts)]}
rspec' = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq (forecast_ $ inputopts_ copts)]}
where
periodq = Date $ periodAsDateSpan $ period_ ropts
-- Except in forecast mode, exclude future/forecast transactions.
@ -198,7 +198,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
-- ,("l", str "list")
,("-+", str "depth")
,("H", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")

8
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -182,13 +182,13 @@ uiReloadJournalIfChanged copts d j ui = do
-- or in the provided UIState's startup options,
-- it is preserved.
enableForecastPreservingPeriod :: UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod ui copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}} =
copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=mforecast}}}
enableForecastPreservingPeriod ui copts@CliOpts{inputopts_=iopts} =
copts{inputopts_=iopts{forecast_=mforecast}}
where
mforecast = asum [mprovidedforecastperiod, mstartupforecastperiod, mdefaultforecastperiod]
where
mprovidedforecastperiod = forecast_ ropts
mstartupforecastperiod = forecast_ $ _rsReportOpts $ reportspec_ $ cliopts_ $ astartupopts ui
mprovidedforecastperiod = forecast_ $ inputopts_ copts
mstartupforecastperiod = forecast_ $ inputopts_ $ cliopts_ $ astartupopts ui
mdefaultforecastperiod = Just nulldatespan
-- Re-check any balance assertions in the current journal, and if any

5
hledger-ui/Hledger/UI/Main.hs
View File

@ -8,6 +8,7 @@ Released under GPL version 3 or later.
module Hledger.UI.Main where
import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
import Control.Monad (forM_, void, when)
@ -43,11 +44,11 @@ writeChan = BC.writeBChan
main :: IO ()
main = do
opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{_rsReportOpts=ropts},rawopts_=rawopts}} <- getHledgerUIOpts
opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- getHledgerUIOpts
-- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
-- always generate forecasted periodic transactions; their visibility will be toggled by the UI.
let copts' = copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=Just $ fromMaybe nulldatespan (forecast_ ropts)}}}
let copts' = copts{inputopts_=iopts{forecast_=forecast_ iopts <|> Just nulldatespan}}
case True of
_ | "help" `inRawOpts` rawopts -> putStr (showModeUsage uimode)

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -239,7 +239,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
-- ,("l", str "list(-subs)")
,("H", renderToggle (not ishistorical) "historical" "period")
,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast")
,("F", renderToggle1 (isJust . forecast_ . inputopts_ $ copts) "forecast")
-- ,("a", "add")
-- ,("g", "reload")
-- ,("q", "quit")

12
hledger-ui/Hledger/UI/UIState.hs
View File

@ -7,8 +7,8 @@ module Hledger.UI.UIState
where
import Brick.Widgets.Edit
import Control.Applicative ((<|>))
import Data.List ((\\), foldl', sort)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Max(..))
import qualified Data.Text as T
import Data.Text.Zipper (gotoEOL)
@ -157,19 +157,19 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec
-- (which are usually but not necessarily future-dated).
-- In normal mode, both of these are hidden.
toggleForecast :: Day -> UIState -> UIState
toggleForecast d ui@UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}}}} =
toggleForecast d ui@UIState{aopts=UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} =
uiSetForecast ui $
case forecast_ ropts of
case forecast_ iopts of
Just _ -> Nothing
Nothing -> Just $ fromMaybe nulldatespan $ forecastPeriodFromRawOpts d $ rawopts_ copts
Nothing -> forecastPeriodFromRawOpts d (rawopts_ copts) <|> Just nulldatespan
-- | Helper: set forecast mode (with the given forecast period) on or off in the UI state.
uiSetForecast :: UIState -> Maybe DateSpan -> UIState
uiSetForecast
ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}}
ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}}
mforecast =
-- we assume forecast mode has no effect on ReportSpec's derived fields
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=mforecast}}}}}
ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{forecast_=mforecast}}}}
-- | Toggle between showing all and showing only real (non-virtual) items.
toggleReal :: UIState -> UIState

8
hledger-web/Hledger/Web/Test.hs
View File

@ -79,14 +79,8 @@ hledgerWebTest = do
-- yit "can add transactions" $ do
-- test with forecasted transactions
d <- getCurrentDay
let
ropts = defreportopts{forecast_=Just nulldatespan}
rspec = case reportOptsToSpec d ropts of
Left e -> error $ "failed to set up report options for tests, shouldn't happen: " ++ show e
Right rs -> rs
copts = defcliopts{reportspec_=rspec, file_=[""]} -- non-empty, see file_ note above
copts = defcliopts{reportspec_=defreportspec, file_=[""]} -- non-empty, see file_ note above
wopts = defwebopts{cliopts_=copts}
j <- fmap (either error id . journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail
["~ monthly"

2
hledger/Hledger/Cli/CliOptions.hs
View File

@ -454,7 +454,7 @@ replaceNumericFlags = map replace
-- Also records the terminal width, if supported.
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts rawopts = do
let iopts = rawOptsToInputOpts rawopts
iopts <- rawOptsToInputOpts rawopts
rspec <- rawOptsToReportSpec rawopts
mcolumns <- readMay <$> getEnvSafe "COLUMNS"
mtermwidth <-

5
hledger/Hledger/Cli/Utils.hs
View File

@ -123,7 +123,7 @@ anonymiseByOpts opts =
--
journalAddForecast :: CliOpts -> Journal -> Either String Journal
journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
case forecast_ ropts of
case forecast_ iopts of
Nothing -> return j
Just _ -> do
forecasttxns <- addAutoTxns =<< mapM (balanceTransaction (balancingopts_ iopts))
@ -135,7 +135,6 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
journalBalanceTransactions (balancingopts_ iopts) j{ jtxns = concat [jtxns j, forecasttxns] }
where
today = _rsDay rspec
ropts = _rsReportOpts rspec
styles = journalCommodityStyles j
-- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
@ -148,7 +147,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
forecastspan = dbg2 "forecastspan" $
spanDefaultsFrom
(fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ ropts)
(fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ iopts)
(DateSpan (Just forecastbeginDefault) (Just forecastendDefault))
addAutoTxns = if auto_ iopts then modifyTransactions styles today (jtxnmodifiers j) else return