run: cache all journal files, allow commands to use -f

This commit is contained in:
Dmitry Astapov 2025-02-22 19:03:36 +00:00 committed by Simon Michael
parent aee85df17b
commit 32f286cc35
4 changed files with 92 additions and 25 deletions

View File

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

View File

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

View File

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

View File

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