From 6becbc78f3c21a9278f201f8290149cf6cc98868 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Thu, 28 Feb 2019 23:19:11 +0100 Subject: [PATCH] cli, web, ui: Replace withJournalDo* variants --- hledger-ui/Hledger/UI/Main.hs | 24 ++++++++---------------- hledger-web/Hledger/Web/Main.hs | 23 ++--------------------- hledger/Hledger/Cli/Main.hs | 4 ++-- hledger/Hledger/Cli/Utils.hs | 8 ++++---- 4 files changed, 16 insertions(+), 43 deletions(-) diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 74d97c3d4..e7415ab67 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -61,28 +61,20 @@ writeChan = BC.writeBChan main :: IO () main = do opts <- getHledgerUIOpts + let copts = cliopts_ opts + copts' = copts + { inputopts_ = (inputopts_ copts) { auto_ = True } + , reportopts_ = (reportopts_ copts) { forecast_ = True } + } + -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) - run opts + run $ opts { cliopts_ = copts' } where run opts | "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage uimode) >> exitSuccess | "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess | "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) - | otherwise = withJournalDoUICommand opts runBrickUi - --- TODO fix nasty duplication of withJournalDo --- | hledger-ui's version of withJournalDo, which turns on --auto and --forecast. -withJournalDoUICommand :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO () -withJournalDoUICommand uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts,reportopts_=ropts}} cmd = do - let copts' = copts{inputopts_=iopts{auto_=True}, reportopts_=ropts{forecast_=True}} - journalpath <- journalFilePathFromOpts copts' - ej <- readJournalFiles (inputopts_ copts') journalpath - let fn = cmd uopts - . pivotByOpts copts' - . anonymiseByOpts copts' - <=< journalApplyValue (reportopts_ copts') - <=< journalAddForecast copts' - either error' fn ej + | otherwise = withJournalDo (cliopts_ opts) (runBrickUi opts) runBrickUi :: UIOpts -> Journal -> IO () runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=ropts}} j = do diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 5e58dd867..4b5321620 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -38,7 +38,7 @@ hledgerWebMain = do hledgerWebDev :: IO (Int, Application) hledgerWebDev = - withJournalDoWeb defwebopts (\o j -> defaultDevelApp loader $ makeApplication o j) + withJournalDo (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts) where loader = Yesod.Default.Config.loadConfig @@ -49,26 +49,7 @@ runWith opts | "help" `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess | "version" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess | "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname) - | otherwise = withJournalDoWeb opts web - --- | A version of withJournalDo specialised for hledger-web. --- Disallows the special - file to avoid some bug, --- takes WebOpts rather than CliOpts. -withJournalDoWeb :: WebOpts -> (WebOpts -> Journal -> IO a) -> IO a -withJournalDoWeb opts@WebOpts {cliopts_ = copts} cmd = do - journalpaths <- journalFilePathFromOpts copts - - -- https://github.com/simonmichael/hledger/issues/202 - -- -f- gives [Error#yesod-core] : hGetContents: illegal operation (handle is closed) - -- Also we may try to write to this file. Just disallow -. - when ("-" `elem` journalpaths) $ -- always non-empty - error' "hledger-web doesn't support -f -, please specify a file path" - mapM_ requireJournalFileExists journalpaths - - -- keep synced with withJournalDo TODO refactor - readJournalFiles (inputopts_ copts) journalpaths - >>= mapM (journalTransform copts) - >>= either error' (cmd opts) + | otherwise = withJournalDo (cliopts_ opts) (web opts) -- | The web command. web :: WebOpts -> Journal -> IO () diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index b23086153..f54851b30 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -175,9 +175,9 @@ main = do cmdaction opts (error "journal-less command tried to use the journal") "add" -> -- should create the journal if missing (ensureJournalFileExists =<< (head <$> journalFilePathFromOpts opts)) >> - withJournalDo opts cmdaction + withJournalDo opts (cmdaction opts) _ -> -- all other commands: read the journal or fail if missing - withJournalDo opts cmdaction + withJournalDo opts (cmdaction opts) ) `orShowHelp` cmdmode diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 5ed96c7bc..bdf996b71 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -61,19 +61,19 @@ import Hledger.Utils -- | 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. -- Or, throw an error. -withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO () +withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a withJournalDo opts cmd = do -- 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 -- to let the add command work. journalpaths <- journalFilePathFromOpts opts - readJournalFiles (inputopts_ opts) journalpaths + readJournalFiles (inputopts_ opts) journalpaths >>= mapM (journalTransform opts) - >>= either error' (cmd opts) + >>= either error' cmd -- | Apply some transformations to the journal if specified by options. -- These include: --- +-- -- - adding forecast transactions (--forecast) -- - converting amounts to market value (--value) -- - pivoting account names (--pivot)