dev: lens: Use TemplateHaskell for ReportOpts and ReportSpec.

Also rename overWithReport/setWithReport to overEither/setEither.

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,
+  overEither,
-  setWithReport,
+  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
+overEither :: ((a -> Either e b) -> s -> Either e t) -> (a -> b) -> s -> Either e t
-overWithReport l f = l (pure . f)
+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
+setEither :: ((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
-setWithReport l = overWithReport l . const
+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.
+-- Note that setEither/overEither should only be necessary with
-class HasReportOpts a where
+-- 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
+instance HasReportOpts ReportOpts
-    interval = reportOptsNoUpdate.interval
-    {-# INLINE interval #-}
 
-    cost :: Lens' a Costing
+instance HasReportOptsNoUpdate ReportSpec where
-    cost = reportOptsNoUpdate.cost
+    reportOptsNoUpdate = rsReportOpts
-    {-# 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 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

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)
-