From 32f286cc35fcde9ce90da02175f929d94573e4a5 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Sat, 22 Feb 2025 19:03:36 +0000 Subject: [PATCH] run: cache all journal files, allow commands to use -f --- hledger/Hledger/Cli/CliOptions.hs | 19 +++++-- hledger/Hledger/Cli/Commands/Run.hs | 80 ++++++++++++++++++++++------ hledger/Hledger/Cli/Commands/Run.md | 6 ++- hledger/Hledger/Cli/Commands/Run.txt | 12 ++++- 4 files changed, 92 insertions(+), 25 deletions(-) diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 1d0a677ea..64af3be4a 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -67,6 +67,7 @@ module Hledger.Cli.CliOptions ( -- * CLI option accessors -- | These do the extra processing required for some options. journalFilePathFromOpts, + journalFilePathFromOptsNoDefault, rulesFilePathFromOpts, outputFileFromOpts, outputFormatFromOpts, @@ -696,12 +697,20 @@ getHledgerCliOpts mode' = do -- File paths can have a READER: prefix naming a reader/data format. journalFilePathFromOpts :: CliOpts -> IO (NE.NonEmpty String) journalFilePathFromOpts opts = do - f <- defaultJournalPath + mbpaths <- journalFilePathFromOptsNoDefault opts + case mbpaths of + Just paths -> return paths + Nothing -> do + f <- defaultJournalPath + return $ NE.fromList [f] + +-- | Like journalFilePathFromOpts, but does not use defaultJournalPath +journalFilePathFromOptsNoDefault :: CliOpts -> IO (Maybe (NE.NonEmpty String)) +journalFilePathFromOptsNoDefault opts = do d <- getCurrentDirectory - maybe - (return $ NE.fromList [f]) - (mapM (expandPathPreservingPrefix d)) - $ NE.nonEmpty $ file_ opts + case NE.nonEmpty $ file_ opts of + Nothing -> return Nothing + Just paths -> Just <$> mapM (expandPathPreservingPrefix d) paths expandPathPreservingPrefix :: FilePath -> PrefixedFilePath -> IO PrefixedFilePath expandPathPreservingPrefix d prefixedf = do diff --git a/hledger/Hledger/Cli/Commands/Run.hs b/hledger/Hledger/Cli/Commands/Run.hs index f34cf1b65..548d0c2d1 100644 --- a/hledger/Hledger/Cli/Commands/Run.hs +++ b/hledger/Hledger/Cli/Commands/Run.hs @@ -15,20 +15,25 @@ module Hledger.Cli.Commands.Run ( ,run' ) where +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.IO as T import System.Console.CmdArgs.Explicit as C ( Mode ) import Hledger import Hledger.Cli.CliOptions +import Control.Concurrent.MVar import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) import Control.Monad.Extra (concatMapM) import System.Directory (doesFileExist) +import System.IO.Unsafe (unsafePerformIO) import System.Console.Haskeline import Safe (headMay) +import Hledger.Cli.Utils (withJournalDo) -- | Command line options for this command. runmode = hledgerCommandMode @@ -47,32 +52,34 @@ run' _opts _j = return () -- | The actual run command. run :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> Journal -> IO () run findBuiltinCommand CliOpts{rawopts_=rawopts} j = do + -- Add current journal to cache + addJournalToCache j defaultJournalKey let args = dbg1 "args" $ listofstringopt "args" rawopts case args of - [] -> runREPL findBuiltinCommand j + [] -> runREPL findBuiltinCommand maybeFile:_ -> do -- Check if arguments could be interpreted as files. -- If not, assume that they are files isFile <- doesFileExist maybeFile case isFile of - True -> runFromFiles findBuiltinCommand args j - False -> runFromArgs findBuiltinCommand args j + True -> runFromFiles findBuiltinCommand args + False -> runFromArgs findBuiltinCommand args -runFromFiles :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> Journal -> IO () -runFromFiles findBuiltinCommand inputfiles j = do +runFromFiles :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () +runFromFiles findBuiltinCommand inputfiles = do dbg1IO "inputfiles" inputfiles -- read commands from all the inputfiles commands <- (flip concatMapM) inputfiles $ \f -> do dbg1IO "reading commands" f lines . T.unpack <$> T.readFile f - forM_ commands (runCommand findBuiltinCommand j . parseCommand) + forM_ commands (runCommand findBuiltinCommand . parseCommand) -runFromArgs :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> Journal -> IO () -runFromArgs findBuiltinCommand args j = do +runFromArgs :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () +runFromArgs findBuiltinCommand args = do -- read commands from all the inputfiles let commands = dbg1 "commands from args" $ splitAtElement "--" args - forM_ commands (runCommand findBuiltinCommand j) + forM_ commands (runCommand findBuiltinCommand) -- When commands are passed on the command line, shell will parse them for us -- When commands are read from file, we need to split the line into command and arguments @@ -81,8 +88,8 @@ parseCommand line = -- # begins a comment, ignore everything after # takeWhile (not. ((Just '#')==) . headMay) $ words' (strip line) -runCommand :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> Journal -> [String] -> IO () -runCommand findBuiltinCommand j cmdline = do +runCommand :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () +runCommand findBuiltinCommand cmdline = do dbg1IO "running command" cmdline -- # begins a comment, ignore everything after # case cmdline of @@ -92,12 +99,12 @@ runCommand findBuiltinCommand j cmdline = do Nothing -> putStrLn $ unwords (cmdname:args) Just (cmdmode,cmdaction) -> do opts <- getHledgerCliOpts' cmdmode args - cmdaction opts j + withJournalCached opts (cmdaction opts) [] -> return () -runREPL :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> Journal -> IO () -runREPL findBuiltinCommand j = do - putStrLn "Enter hledger commands, or 'help' for help." +runREPL :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> IO () +runREPL findBuiltinCommand = do + putStrLn "Enter hledger commands, or 'quit' for help." runInputT defaultSettings loop where loop :: InputT IO () @@ -108,5 +115,46 @@ runREPL findBuiltinCommand j = do Just "quit" -> return () Just "exit" -> return () Just input -> do - liftIO $ runCommand findBuiltinCommand j $ parseCommand input + liftIO $ runCommand findBuiltinCommand $ parseCommand input loop + +{-# NOINLINE journalCache #-} +journalCache :: MVar (Map.Map [String] Journal) +journalCache = unsafePerformIO $ newMVar Map.empty + +-- | Key used to cache the journal given in the arguments to 'run'. +defaultJournalKey :: [String] +defaultJournalKey = ["journal specified in args of run"] + +hasStdin :: [String] -> Bool +hasStdin fps = "-" `elem` fps + +addJournalToCache :: Journal -> [String] -> IO () +addJournalToCache j journalpaths = modifyMVar_ journalCache $ \cache -> + if hasStdin $ dbg1 "addJournalToCache" journalpaths + then return cache + else return $ Map.insert journalpaths j cache + +withJournalCached :: CliOpts -> (Journal -> IO ()) -> IO () +withJournalCached cliopts f = do + journalpaths <- journalFilePathFromOptsNoDefault cliopts + -- if command does not have -f flags, use the same journal that was given to the "run" invocation + let key = case journalpaths of + Nothing -> defaultJournalKey + Just paths -> NE.toList paths + dbg1IO "withJournalCached key" key + modifyMVar_ journalCache $ \cache -> + if hasStdin key + then do dbg1IO "withJournalCached skipping cache due to stdin" key + withJournalDo cliopts f + return cache + else case Map.lookup key cache of + Just journal -> do + dbg1IO "withJournalCached using cache" key + f journal + return cache + Nothing -> do + dbg1IO "withJournalCached reading and caching journal" key + withJournalDo cliopts $ \j -> do + f j + return (Map.insert key j cache) diff --git a/hledger/Hledger/Cli/Commands/Run.md b/hledger/Hledger/Cli/Commands/Run.md index 3bce630ee..ed4178536 100644 --- a/hledger/Hledger/Cli/Commands/Run.md +++ b/hledger/Hledger/Cli/Commands/Run.md @@ -35,6 +35,8 @@ You can use `#!/usr/bin/env hledger run` in the first line of the file to make i - Numeric flags like `-3` do not work, use long form `--depth 3` +- You can pass `-f` to the `run` itself, and also to any commands given after it (or in the command file, or via REPL). When specific command does not have `-f` in its flags, it will use the journal(s) specified in the arguments of `run`. If command does have `-f` flag, this journal would be read and its contents would be cache, so if several commands specify the same `-f` flag, they will read the journal only once. + ### Examples: To start the REPL: @@ -44,7 +46,7 @@ hledger run To provide commands on the command line, separate them with `--`: ```cli -hledger run -f some.journal -- balance assets --depth 2 -- balance liabilities --depth 3 --transpose +hledger run -f some.journal -- balance assets --depth 2 -- balance liabilities -f /some/other.journal --depth 3 --transpose ``` To provide commands in the file, as a runnable scripts: @@ -57,6 +59,6 @@ echo "Assets" balance assets --depth 2 echo "Liabilities" -balance liabilities --depth 3 --transpose +balance liabilities -f /some/other.journal --depth 3 --transpose ``` diff --git a/hledger/Hledger/Cli/Commands/Run.txt b/hledger/Hledger/Cli/Commands/Run.txt index 23d9c088f..57758c796 100644 --- a/hledger/Hledger/Cli/Commands/Run.txt +++ b/hledger/Hledger/Cli/Commands/Run.txt @@ -44,6 +44,14 @@ Caveats: - Numeric flags like -3 do not work, use long form --depth 3 +- You can pass -f to the run itself, and also to any commands given + after it (or in the command file, or via REPL). When specific + command does not have -f in its flags, it will use the journal(s) + specified in the arguments of run. If command does have -f flag, + this journal would be read and its contents would be cache, so if + several commands specify the same -f flag, they will read the + journal only once. + Examples: To start the REPL: @@ -52,7 +60,7 @@ hledger run To provide commands on the command line, separate them with --: -hledger run -f some.journal -- balance assets --depth 2 -- balance liabilities --depth 3 --transpose +hledger run -f some.journal -- balance assets --depth 2 -- balance liabilities -f /some/other.journal --depth 3 --transpose To provide commands in the file, as a runnable scripts: @@ -64,4 +72,4 @@ echo "Assets" balance assets --depth 2 echo "Liabilities" -balance liabilities --depth 3 --transpose +balance liabilities -f /some/other.journal --depth 3 --transpose