lib!: rename withJournal -> withJournalDo, with alias and deprecation warning

This commit is contained in:
Simon Michael 2025-09-11 10:02:27 +01:00
parent 2c18614e7b
commit e64c26e603
19 changed files with 28 additions and 24 deletions

View File

@ -44,5 +44,5 @@ main = do
mbReport args = do mbReport args = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args
d <- getCurrentDay d <- getCurrentDay
(report,j) <- withJournalDo opts $ \j -> return (multiBalanceReport rspec j, j) (report,j) <- withJournal opts $ \j -> return (multiBalanceReport rspec j, j)
return (opts, _rsReportOpts rspec,j,report) return (opts, _rsReportOpts rspec,j,report)

View File

@ -36,7 +36,7 @@ Check that no postings are made to accounts with a postable:(n|no) tag.
main :: IO () main :: IO ()
main = do main = do
opts@CliOpts{reportspec_=_rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=_rspec} <- getHledgerCliOpts cmdmode
withJournalDo opts $ \j -> do withJournal opts $ \j -> do
let let
postedaccts = journalAccountNamesUsed j postedaccts = journalAccountNamesUsed j
checkAcctPostable :: Journal -> AccountName -> Either AccountName () checkAcctPostable :: Journal -> AccountName -> Either AccountName ()

View File

@ -21,7 +21,7 @@ import Hledger.Cli.Script
import System.Directory import System.Directory
import System.Exit import System.Exit
main = withJournalDo defcliopts $ \j -> do main = withJournal defcliopts $ \j -> do
let filetags = [ (t,v) let filetags = [ (t,v)
| (t',v') <- concatMap transactionAllTags $ jtxns j | (t',v') <- concatMap transactionAllTags $ jtxns j
, let t = T.unpack t' , let t = T.unpack t'

View File

@ -22,7 +22,7 @@ import Hledger.Cli.Script
import System.Directory import System.Directory
import System.Exit import System.Exit
main = withJournalDo defcliopts $ \j -> do main = withJournal defcliopts $ \j -> do
let filetags = [ (t,v) let filetags = [ (t,v)
| (t',v') <- concatMap transactionAllTags $ jtxns j | (t',v') <- concatMap transactionAllTags $ jtxns j
, let t = T.unpack t' , let t = T.unpack t'

View File

@ -69,5 +69,5 @@ main = do
where where
mbReport args = do mbReport args = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args
report <- withJournalDo opts (return . multiBalanceReport rspec) report <- withJournal opts (return . multiBalanceReport rspec)
return (rspec,report) return (rspec,report)

View File

@ -128,7 +128,7 @@ $ hledger-move all assets:broker1:FOO assets:broker2:FOO # move all FOO lots to
main :: IO () main :: IO ()
main = do main = do
copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} <- getHledgerCliOpts cmdmode copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} <- getHledgerCliOpts cmdmode
withJournalDo copts $ \j -> do withJournal copts $ \j -> do
-- d <- getCurrentDay -- d <- getCurrentDay
let let
-- arg errors -- arg errors

View File

@ -34,7 +34,7 @@ import Hledger.Cli.Script
main = do main = do
args <- getArgs args <- getArgs
opts <- argsToCliOpts ("register" : args) [] opts <- argsToCliOpts ("register" : args) []
withJournalDo opts $ \j -> do withJournal opts $ \j -> do
let let
r = postingsReport (reportspec_ opts) j r = postingsReport (reportspec_ opts) j
getamt = pamount.fourth5 getamt = pamount.fourth5

View File

@ -30,7 +30,7 @@ cmdmode = hledgerCommandMode (unlines
main = do main = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode
withJournalDo opts $ \j -> do withJournal opts $ \j -> do
let let
r = postingsReport rspec j r = postingsReport rspec j
maxbal = fifth5 $ maximumBy (comparing fifth5) r maxbal = fifth5 $ maximumBy (comparing fifth5) r

View File

@ -23,7 +23,7 @@ cmdmode = hledgerCommandMode (unlines
main = do main = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode
withJournalDo opts $ flip compoundBalanceCommand opts $ withJournal opts $ flip compoundBalanceCommand opts $
-- see https://hackage.haskell.org/package/hledger/docs/Hledger-Cli-CompoundBalanceCommand.html -- see https://hackage.haskell.org/package/hledger/docs/Hledger-Cli-CompoundBalanceCommand.html
-- and https://hackage.haskell.org/package/hledger-lib-1.31/docs/Hledger-Query.html -- and https://hackage.haskell.org/package/hledger-lib-1.31/docs/Hledger-Query.html

View File

@ -25,7 +25,7 @@ cmdmode = hledgerCommandMode (unlines
main = do main = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode
withJournalDo opts $ \j -> do withJournal opts $ \j -> do
putStrLn "hello" putStrLn "hello"

View File

@ -68,7 +68,7 @@ main = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode
-- 2. read the journal file -- 2. read the journal file
withJournalDo opts $ \j -> do withJournal opts $ \j -> do
-- 3. do something with it. -- 3. do something with it.
putStrLn $ (show $ length $ jtxns j) <> " transactions in " <> (show $ journalFilePath j) putStrLn $ (show $ length $ jtxns j) <> " transactions in " <> (show $ journalFilePath j)

View File

@ -63,7 +63,7 @@ main = do
-- Don't let our ACCT argument be interpreted as a query by print -- Don't let our ACCT argument be interpreted as a query by print
,reportspec_ = rspec{_rsReportOpts=ropts{querystring_=[]}} ,reportspec_ = rspec{_rsReportOpts=ropts{querystring_=[]}}
} }
withJournalDo copts' $ \j -> do withJournal copts' $ \j -> do
today <- getCurrentDay today <- getCurrentDay
let let
menddate = reportPeriodLastDay rspec menddate = reportPeriodLastDay rspec

View File

@ -28,7 +28,7 @@ Swap date and date2, on transactions which have date2 defined.
main :: IO () main :: IO ()
main = do main = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts cmdmode
withJournalDo opts $ withJournal opts $
\j -> do \j -> do
d <- getCurrentDay d <- getCurrentDay
let let

View File

@ -100,7 +100,7 @@ Try tracing the execution of a hledger command:
1. [Hledger.Cli.Main:main](https://github.com/simonmichael/hledger/blob/master/hledger/Hledger/Cli/Main.hs#L302) 1. [Hledger.Cli.Main:main](https://github.com/simonmichael/hledger/blob/master/hledger/Hledger/Cli/Main.hs#L302)
parses the command line to select a command, then parses the command line to select a command, then
2. gives it to 2. gives it to
[Hledger.Cli.Utils:withJournalDo](https://github.com/simonmichael/hledger/blob/master/hledger/Hledger/Cli/Utils.hs#L73), [Hledger.Cli.Utils:withJournal](https://github.com/simonmichael/hledger/blob/master/hledger/Hledger/Cli/Utils.hs#L73),
which runs it after doing all the initial parsing. which runs it after doing all the initial parsing.
3. Parsing code is under 3. Parsing code is under
[hledger-lib:Hledger.Read](https://github.com/simonmichael/hledger/tree/master/hledger-lib/Hledger/Read.hs), [hledger-lib:Hledger.Read](https://github.com/simonmichael/hledger/tree/master/hledger-lib/Hledger/Read.hs),

View File

@ -118,7 +118,7 @@ hledgerUiMain = handleExit $ withGhcDebug' $ withProgName "hledger-ui.log" $ do
_ | boolopt "man" rawopts -> runManForTopic "hledger-ui" Nothing _ | boolopt "man" rawopts -> runManForTopic "hledger-ui" Nothing
_ | boolopt "version" rawopts -> putStrLn prognameandversion _ | boolopt "version" rawopts -> putStrLn prognameandversion
-- _ | boolopt "binary-filename" rawopts -> putStrLn (binaryfilename progname) -- _ | boolopt "binary-filename" rawopts -> putStrLn (binaryfilename progname)
_ -> withJournalDo copts' (runBrickUi opts) _ -> withJournal copts' (runBrickUi opts)
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause' when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'

View File

@ -53,7 +53,7 @@ import Hledger.Web.WebOptions
-- Run in fast reloading mode for yesod devel. -- Run in fast reloading mode for yesod devel.
hledgerWebDev :: IO (Int, Application) hledgerWebDev :: IO (Int, Application)
hledgerWebDev = hledgerWebDev =
withJournalDo (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts) withJournal (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts)
where where
loader = loader =
Yesod.Default.Config.loadConfig Yesod.Default.Config.loadConfig
@ -93,7 +93,7 @@ hledgerWebMain = handleExit $ withGhcDebug' $ do
| boolopt "test" rawopts_ -> do | boolopt "test" rawopts_ -> do
-- remove --test and --, leaving other args for hspec -- remove --test and --, leaving other args for hspec
(`withArgs` hledgerWebTest) . filter (`notElem` ["--test","--"]) =<< getArgs (`withArgs` hledgerWebTest) . filter (`notElem` ["--test","--"]) =<< getArgs
| otherwise -> withJournalDo copts (web wopts) | otherwise -> withJournal copts (web wopts)
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause' when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'

View File

@ -14,7 +14,7 @@ stack new projectname yesodweb/sqlite
These tests don't exactly match the production code path, eg these bits are missing: These tests don't exactly match the production code path, eg these bits are missing:
withJournalDo copts (web wopts) -- extra withJournalDo logic (journalTransform..) withJournal copts (web wopts) -- extra withJournal logic (journalTransform..)
... ...
-- query logic, more options logic -- query logic, more options logic
let depthlessinitialq = filterQuery (not . queryIsDepth) . _rsQuery . reportspec_ $ cliopts_ wopts let depthlessinitialq = filterQuery (not . queryIsDepth) . _rsQuery . reportspec_ $ cliopts_ wopts

View File

@ -429,14 +429,14 @@ main = handleExit $ withGhcDebug' $ do
-- 6.4.3. builtin command which should create the journal if missing - do that and run it -- 6.4.3. builtin command which should create the journal if missing - do that and run it
| cmdname `elem` ["add","import"] -> do | cmdname `elem` ["add","import"] -> do
ensureJournalFileExists . NE.head =<< journalFilePathFromOpts opts ensureJournalFileExists . NE.head =<< journalFilePathFromOpts opts
withJournalDo opts (cmdaction opts) withJournal opts (cmdaction opts)
-- 6.4.4. "run" and "repl" need findBuiltinCommands passed to it to avoid circular dependency in the code -- 6.4.4. "run" and "repl" need findBuiltinCommands passed to it to avoid circular dependency in the code
| cmdname == "run" -> Hledger.Cli.Commands.Run.run Nothing findBuiltinCommand addons opts | cmdname == "run" -> Hledger.Cli.Commands.Run.run Nothing findBuiltinCommand addons opts
| cmdname == "repl" -> Hledger.Cli.Commands.Run.repl findBuiltinCommand addons opts | cmdname == "repl" -> Hledger.Cli.Commands.Run.repl findBuiltinCommand addons opts
-- 6.4.5. all other builtin commands - read the journal and if successful run the command with it -- 6.4.5. all other builtin commands - read the journal and if successful run the command with it
| otherwise -> withJournalDo opts $ cmdaction opts | otherwise -> withJournal opts $ cmdaction opts
-- 6.5. external addon command found - run it, -- 6.5. external addon command found - run it,
-- passing any cli arguments written after the command name -- passing any cli arguments written after the command name

View File

@ -10,6 +10,7 @@ Hledger.Utils.
module Hledger.Cli.Utils module Hledger.Cli.Utils
( (
unsupportedOutputFormatError, unsupportedOutputFormatError,
withJournal,
withJournalDo, withJournalDo,
writeOutput, writeOutput,
writeOutputLazyText, writeOutputLazyText,
@ -67,8 +68,8 @@ unsupportedOutputFormatError fmt = "Sorry, output format \""++fmt++"\" is unreco
-- | Parse the user's specified journal file(s) as a Journal, maybe apply some -- | Parse the user's specified journal file(s) as a Journal, maybe apply some
-- transformations according to options, and run a hledger command with it. -- transformations according to options, and run a hledger command with it.
-- Or, throw an error. -- Or, throw an error.
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a withJournal :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo opts cmd = do withJournal opts cmd = do
-- We kludgily read the file before parsing to grab the full text, unless -- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly -- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work. -- to let the add command work.
@ -76,6 +77,9 @@ withJournalDo opts cmd = do
j <- runExceptT $ journalTransform opts <$> readJournalFiles (inputopts_ opts) (NE.toList journalpaths) j <- runExceptT $ journalTransform opts <$> readJournalFiles (inputopts_ opts) (NE.toList journalpaths)
either error' cmd j -- PARTIAL: either error' cmd j -- PARTIAL:
{-# DEPRECATED withJournalDo "renamed, please use withJournal instead" #-}
withJournalDo = withJournal
-- | Apply some extra post-parse transformations to the journal, if enabled by options. -- | Apply some extra post-parse transformations to the journal, if enabled by options.
-- These happen after parsing and finalising the journal, but before report calculation. -- These happen after parsing and finalising the journal, but before report calculation.
-- They are, in processing order: -- They are, in processing order:
@ -89,7 +93,7 @@ journalTransform opts =
pivotByOpts opts pivotByOpts opts
<&> anonymiseByOpts opts <&> anonymiseByOpts opts
<&> maybeObfuscate opts <&> maybeObfuscate opts
-- XXX Called by withJournalDo, journalReload, uiReloadJournal, withJournalCached. -- XXX Called by withJournal, journalReload, uiReloadJournal, withJournalCached.
-- Could it be moved down into journalFinalise ? These steps only depend on InputOpts. -- Could it be moved down into journalFinalise ? These steps only depend on InputOpts.
-- | Apply the pivot transformation on a journal (replacing account names by a different field's value), if option is present. -- | Apply the pivot transformation on a journal (replacing account names by a different field's value), if option is present.
@ -142,7 +146,7 @@ writeOutputLazyText opts s = do
-- them has changed since last read. (If the file is standard input, -- them has changed since last read. (If the file is standard input,
-- this will either do nothing or give an error, not tested yet). -- this will either do nothing or give an error, not tested yet).
-- Returns a journal or error message, and a flag indicating whether -- Returns a journal or error message, and a flag indicating whether
-- it was re-read or not. Like withJournalDo and journalReload, reads -- it was re-read or not. Like withJournal and journalReload, reads
-- the full journal, without filtering. -- the full journal, without filtering.
journalReloadIfChanged :: CliOpts -> Day -> Journal -> ExceptT String IO (Journal, Bool) journalReloadIfChanged :: CliOpts -> Day -> Journal -> ExceptT String IO (Journal, Bool)
journalReloadIfChanged opts _d j = do journalReloadIfChanged opts _d j = do