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

dev: lens: Use TemplateHaskell for ReportOpts and ReportSpec.

Browse Source 
Also rename overWithReport/setWithReport to overEither/setEither.
This commit is contained in:
Stephen Morgan 2021-08-25 20:04:44 +10:00 committed by Simon Michael
parent 435ec992f9
commit f3eacebc1d
2 changed files with 73 additions and 234 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -747,4 +747,3 @@ getDirectoryContentsSafe d =
-- putStrLn $ "processed opts:\n" ++ show opts
-- d <- getCurrentDay
-- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)