From f3eacebc1db73fa9682e2dbbbebb05aa6ef2145d Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 25 Aug 2021 20:04:44 +1000 Subject: [PATCH] dev: lens: Use TemplateHaskell for ReportOpts and ReportSpec. Also rename overWithReport/setWithReport to overEither/setEither. --- hledger-lib/Hledger/Reports/ReportOptions.hs | 306 +++++-------------- hledger/Hledger/Cli/CliOptions.hs | 1 - 2 files changed, 73 insertions(+), 234 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 3ef2c3a0a..ae16d9451 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -11,15 +11,17 @@ Options common to most hledger reports. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Hledger.Reports.ReportOptions ( ReportOpts(..), + HasReportOptsNoUpdate(..), HasReportOpts(..), ReportSpec(..), HasReportSpec(..), - overWithReport, - setWithReport, + overEither, + setEither, BalanceCalculation(..), BalanceAccumulation(..), AccountListMode(..), @@ -67,7 +69,6 @@ import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) -import Lens.Micro (Lens') import Safe (headMay, lastDef, lastMay, maximumMay) import Text.Megaparsec.Custom @@ -274,35 +275,6 @@ defreportspec = ReportSpec , _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 - { _rsReportOpts = ropts - , _rsDay = 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, _rsReportOpts, querystring_, etc.) are in sync. -updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec -updateReportSpec = setWithReport reportOpts - --- | Like updateReportSpec, but takes a ReportOpts-modifying function. -updateReportSpecWith :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec -updateReportSpecWith = overWithReport reportOpts - --- | Generate a ReportSpec from RawOpts and the current date. -rawOptsToReportSpec :: RawOpts -> IO ReportSpec -rawOptsToReportSpec rawopts = do - d <- getCurrentDay - let ropts = rawOptsToReportOpts d rawopts - either fail return $ reportOptsToSpec d ropts - accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = fromMaybe ALFlat . choiceopt parse where @@ -709,237 +681,105 @@ instance (e ~ a) => Reportable (Either a) e where report _ = join -- | Apply a function over a lens, but report on failure. -overWithReport :: ((a -> Either e b) -> s -> Either e t) -> (a -> b) -> s -> Either e t -overWithReport l f = l (pure . f) +overEither :: ((a -> Either e b) -> s -> Either e t) -> (a -> b) -> s -> Either e t +overEither l f = l (pure . f) -- | Set a field using a lens, but report on failure. -setWithReport :: ((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t -setWithReport l = overWithReport l . const +setEither :: ((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t +setEither l = overEither l . const type ReportableLens' s a = forall f. Reportable f String => (a -> f a) -> s -> f s -- | Lenses for ReportOpts. --- Note that some of these are not true lenses, as they have a further restriction on + +-- 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. --- The special type is so that updating querystring_, real_, depth_, date2_, period_, or --- statuses_ can automatically update the Query and QueryOpts in ReportSpec. -class HasReportOpts a where +-- +-- Note that setEither/overEither should only be necessary with +-- querystring and reportOpts: the other lenses should never fail. +-- +-- === Examples: +-- >>> import Lens.Micro (set) +-- >>> _rsQuery <$> setEither querystring ["assets"] defreportspec +-- Right (Acct (RegexpCI "assets")) +-- >>> _rsQuery <$> setEither querystring ["(assets"] defreportspec +-- Left "this regular expression could not be compiled: (assets" +-- >>> _rsQuery $ set querystring ["assets"] defreportspec +-- Acct (RegexpCI "assets") +-- >>> _rsQuery $ set querystring ["(assets"] defreportspec +-- *** Exception: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set +-- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec +-- Date DateSpan 2021-08 +class HasReportOptsNoUpdate a => HasReportOpts a where reportOpts :: ReportableLens' a ReportOpts - reportOptsNoUpdate :: Lens' a ReportOpts + reportOpts = reportOptsNoUpdate + {-# INLINE reportOpts #-} period :: ReportableLens' a Period - period = reportOpts.period + period = reportOpts.periodNoUpdate {-# INLINE period #-} statuses :: ReportableLens' a [Status] - statuses = reportOpts.statuses + statuses = reportOpts.statusesNoUpdate {-# INLINE statuses #-} depth :: ReportableLens' a (Maybe Int) - depth = reportOpts.depth + depth = reportOpts.depthNoUpdate {-# INLINE depth #-} date2 :: ReportableLens' a Bool - date2 = reportOpts.date2 + date2 = reportOpts.date2NoUpdate {-# INLINE date2 #-} real :: ReportableLens' a Bool - real = reportOpts.real + real = reportOpts.realNoUpdate {-# INLINE real #-} querystring :: ReportableLens' a [T.Text] - querystring = reportOpts.querystring + querystring = reportOpts.querystringNoUpdate {-# INLINE querystring #-} - interval :: Lens' a Interval - interval = reportOptsNoUpdate.interval - {-# INLINE interval #-} +instance HasReportOpts ReportOpts - cost :: Lens' a Costing - cost = reportOptsNoUpdate.cost - {-# INLINE cost #-} - - value :: Lens' a (Maybe ValuationType) - value = reportOptsNoUpdate.value - {-# INLINE value #-} - - infer_value :: Lens' a Bool - infer_value = reportOptsNoUpdate.infer_value - {-# INLINE infer_value #-} - - empty__ :: Lens' a Bool - empty__ = reportOptsNoUpdate.empty__ - {-# INLINE empty__ #-} - - no_elide :: Lens' a Bool - no_elide = reportOptsNoUpdate.no_elide - {-# INLINE no_elide #-} - - format :: Lens' a StringFormat - format = reportOptsNoUpdate.format - {-# INLINE format #-} - - average :: Lens' a Bool - average = reportOptsNoUpdate.average - {-# INLINE average #-} - - related :: Lens' a Bool - related = reportOptsNoUpdate.related - {-# INLINE related #-} - - txn_dates :: Lens' a Bool - txn_dates = reportOptsNoUpdate.txn_dates - {-# INLINE txn_dates #-} - - balancecalc :: Lens' a BalanceCalculation - balancecalc = reportOptsNoUpdate.balancecalc - {-# INLINE balancecalc #-} - - balanceaccum :: Lens' a BalanceAccumulation - balanceaccum = reportOptsNoUpdate.balanceaccum - {-# INLINE balanceaccum #-} - - accountlistmode :: Lens' a AccountListMode - accountlistmode = reportOptsNoUpdate.accountlistmode - {-# INLINE accountlistmode #-} - - drop__ :: Lens' a Int - drop__ = reportOptsNoUpdate.drop__ - {-# INLINE drop__ #-} - - row_total :: Lens' a Bool - row_total = reportOptsNoUpdate.row_total - {-# INLINE row_total #-} - - no_total :: Lens' a Bool - no_total = reportOptsNoUpdate.no_total - {-# INLINE no_total #-} - - show_costs :: Lens' a Bool - show_costs = reportOptsNoUpdate.show_costs - {-# INLINE show_costs #-} - - pretty_tables :: Lens' a Bool - pretty_tables = reportOptsNoUpdate.pretty_tables - {-# INLINE pretty_tables #-} - - sort_amount :: Lens' a Bool - sort_amount = reportOptsNoUpdate.sort_amount - {-# INLINE sort_amount #-} - - percent :: Lens' a Bool - percent = reportOptsNoUpdate.percent - {-# INLINE percent #-} - - invert :: Lens' a Bool - invert = reportOptsNoUpdate.invert - {-# INLINE invert #-} - - normalbalance :: Lens' a (Maybe NormalSign) - normalbalance = reportOptsNoUpdate.normalbalance - {-# INLINE normalbalance #-} - - color__ :: Lens' a Bool - color__ = reportOptsNoUpdate.color__ - {-# INLINE color__ #-} - - transpose__ :: Lens' a Bool - transpose__ = reportOptsNoUpdate.transpose__ - {-# INLINE transpose__ #-} - -instance HasReportOpts ReportOpts where - reportOpts = id - reportOptsNoUpdate = id - period f ropts = (\x -> ropts{period_=x}) <$> f (period_ ropts) - {-# INLINE period #-} - interval f ropts = (\x -> ropts{interval_=x}) <$> f (interval_ ropts) - {-# INLINE interval #-} - statuses f ropts = (\x -> ropts{statuses_=x}) <$> f (statuses_ ropts) - {-# INLINE statuses #-} - cost f ropts = (\x -> ropts{cost_=x}) <$> f (cost_ ropts) - {-# INLINE cost #-} - value f ropts = (\x -> ropts{value_=x}) <$> f (value_ ropts) - {-# INLINE value #-} - infer_value f ropts = (\x -> ropts{infer_value_=x}) <$> f (infer_value_ ropts) - {-# INLINE infer_value #-} - depth f ropts = (\x -> ropts{depth_=x}) <$> f (depth_ ropts) - {-# INLINE depth #-} - date2 f ropts = (\x -> ropts{date2_=x}) <$> f (date2_ ropts) - {-# INLINE date2 #-} - empty__ f ropts = (\x -> ropts{empty_=x}) <$> f (empty_ ropts) - {-# INLINE empty__ #-} - no_elide f ropts = (\x -> ropts{no_elide_=x}) <$> f (no_elide_ ropts) - {-# INLINE no_elide #-} - real f ropts = (\x -> ropts{real_=x}) <$> f (real_ ropts) - {-# INLINE real #-} - format f ropts = (\x -> ropts{format_=x}) <$> f (format_ ropts) - {-# INLINE format #-} - querystring f ropts = (\x -> ropts{querystring_=x}) <$> f (querystring_ ropts) - {-# INLINE querystring #-} - average f ropts = (\x -> ropts{average_=x}) <$> f (average_ ropts) - {-# INLINE average #-} - related f ropts = (\x -> ropts{related_=x}) <$> f (related_ ropts) - {-# INLINE related #-} - txn_dates f ropts = (\x -> ropts{txn_dates_=x}) <$> f (txn_dates_ ropts) - {-# INLINE txn_dates #-} - balancecalc f ropts = (\x -> ropts{balancecalc_=x}) <$> f (balancecalc_ ropts) - {-# INLINE balancecalc #-} - balanceaccum f ropts = (\x -> ropts{balanceaccum_=x}) <$> f (balanceaccum_ ropts) - {-# INLINE balanceaccum #-} - accountlistmode f ropts = (\x -> ropts{accountlistmode_=x}) <$> f (accountlistmode_ ropts) - {-# INLINE accountlistmode #-} - drop__ f ropts = (\x -> ropts{drop_=x}) <$> f (drop_ ropts) - {-# INLINE drop__ #-} - row_total f ropts = (\x -> ropts{row_total_=x}) <$> f (row_total_ ropts) - {-# INLINE row_total #-} - no_total f ropts = (\x -> ropts{no_total_=x}) <$> f (no_total_ ropts) - {-# INLINE no_total #-} - show_costs f ropts = (\x -> ropts{show_costs_=x}) <$> f (show_costs_ ropts) - {-# INLINE show_costs #-} - pretty_tables f ropts = (\x -> ropts{pretty_tables_=x}) <$> f (pretty_tables_ ropts) - {-# INLINE pretty_tables #-} - sort_amount f ropts = (\x -> ropts{sort_amount_=x}) <$> f (sort_amount_ ropts) - {-# INLINE sort_amount #-} - percent f ropts = (\x -> ropts{percent_=x}) <$> f (percent_ ropts) - {-# INLINE percent #-} - invert f ropts = (\x -> ropts{invert_=x}) <$> f (invert_ ropts) - {-# INLINE invert #-} - normalbalance f ropts = (\x -> ropts{normalbalance_=x}) <$> f (normalbalance_ ropts) - {-# INLINE normalbalance #-} - color__ f ropts = (\x -> ropts{color_=x}) <$> f (color_ ropts) - {-# INLINE color__ #-} - transpose__ f ropts = (\x -> ropts{transpose_=x}) <$> f (transpose_ ropts) - {-# INLINE transpose__ #-} - -class HasReportSpec a where - reportSpec :: Lens' a ReportSpec - - rsDay :: Lens' a Day - rsDay = reportSpec.rsDay - {-# INLINE rsDay #-} - - rsQuery :: Lens' a Query - rsQuery = reportSpec.rsQuery - {-# INLINE rsQuery #-} - - rsQueryOpts :: Lens' a [QueryOpt] - rsQueryOpts = reportSpec.rsQueryOpts - {-# INLINE rsQueryOpts #-} - -instance HasReportSpec ReportSpec where - reportSpec = id - rsDay f rspec = (\d -> either (error "Updating _rsDay should never fail") id . -- PARTIAL: - reportOptsToSpec d $ _rsReportOpts rspec) <$> f (_rsDay rspec) - {-# INLINE rsDay #-} - rsQuery f rspec = (\x -> rspec{_rsQuery=x}) <$> f (_rsQuery rspec) - {-# INLINE rsQuery #-} - rsQueryOpts f rspec = (\x -> rspec{_rsQueryOpts=x}) <$> f (_rsQueryOpts rspec) - {-# INLINE rsQueryOpts #-} +instance HasReportOptsNoUpdate ReportSpec where + reportOptsNoUpdate = rsReportOpts instance HasReportOpts ReportSpec where - reportOpts f rspec = report (error "Updating ReportSpec failed: try using overWithReport instead of over") $ -- PARTIAL: + reportOpts f rspec = report (error' "Updating ReportSpec failed: try using overEither instead of over or setEither instead of set") $ -- PARTIAL: reportOptsToSpec (_rsDay rspec) <$> f (_rsReportOpts rspec) {-# INLINE reportOpts #-} - reportOptsNoUpdate f rspec = (\x -> rspec{_rsReportOpts=x}) <$> f (_rsReportOpts rspec) - {-# INLINE reportOptsNoUpdate #-} + +-- | Generate a ReportSpec from a set of ReportOpts on a given day. +reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec +reportOptsToSpec day ropts = do + (argsquery, queryopts) <- parseQueryList day $ querystring_ ropts + return ReportSpec + { _rsReportOpts = ropts + , _rsDay = day + , _rsQuery = simplifyQuery $ And [queryFromFlags ropts, argsquery] + , _rsQueryOpts = queryopts + } + +-- | Update the ReportOpts and the fields derived from it in a ReportSpec, +-- or return an error message if there is a problem such as missing or +-- unparseable options data. This is the safe way to change a ReportSpec, +-- ensuring that all fields (_rsQuery, _rsReportOpts, querystring_, etc.) are in sync. +updateReportSpec :: ReportOpts -> ReportSpec -> Either String ReportSpec +updateReportSpec = setEither reportOpts + +-- | Like updateReportSpec, but takes a ReportOpts-modifying function. +updateReportSpecWith :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec +updateReportSpecWith = overEither reportOpts + +-- | Generate a ReportSpec from RawOpts and the current date. +rawOptsToReportSpec :: RawOpts -> IO ReportSpec +rawOptsToReportSpec rawopts = do + d <- getCurrentDay + let ropts = rawOptsToReportOpts d rawopts + either fail return $ reportOptsToSpec d ropts diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index d67f0d97d..7a9f88695 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -747,4 +747,3 @@ getDirectoryContentsSafe d = -- putStrLn $ "processed opts:\n" ++ show opts -- d <- getCurrentDay -- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) -