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

run: cache input files by (iopts, name), allows commands with different iopts

Browse Source
This commit is contained in:
Dmitry Astapov 2025-03-03 20:55:39 +00:00 committed by Simon Michael
parent d3d3e02f9e
commit 1fc7006919
4 changed files with 44 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Balancing.hs
View File

@ -64,7 +64,7 @@ data BalancingOpts = BalancingOpts
, infer_balancing_costs_ :: Bool -- ^ Are we permitted to infer missing costs to balance transactions ?
-- Distinct from InputOpts{infer_costs_}.
, commodity_styles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
} deriving (Show)
} deriving (Eq, Ord, Show)
defbalancingopts :: BalancingOpts
defbalancingopts = BalancingOpts

4
hledger-lib/Hledger/Data/Types.hs
View File

@ -666,7 +666,7 @@ data SepFormat
= Csv -- comma-separated
| Tsv -- tab-separated
| Ssv -- semicolon-separated
deriving Eq
deriving (Eq, Ord)
-- | The id of a data format understood by hledger, eg @journal@ or @csv@.
-- The --output-format option selects one of these for output.
@ -677,7 +677,7 @@ data StorageFormat
| Timeclock
| Timedot
| Sep SepFormat
deriving Eq
deriving (Eq, Ord)
instance Show SepFormat where
show Csv = "csv"

2
hledger-lib/Hledger/Read/InputOptions.hs
View File

@ -44,7 +44,7 @@ data InputOpts = InputOpts {
,strict_ :: Bool -- ^ do extra correctness checks ?
,_defer :: Bool -- ^ internal flag: postpone checks, because we are processing multiple files ?
,_ioDay :: Day -- ^ today's date, for use with forecast transactions XXX this duplicates _rsDay, and should eventually be removed when it's not needed anymore.
} deriving (Show)
} deriving (Eq, Ord, Show)
definputopts :: InputOpts
definputopts = InputOpts

74
hledger/Hledger/Cli/Commands/Run.hs
View File

@ -17,6 +17,7 @@ module Hledger.Cli.Commands.Run (
,runOrReplStub
) where
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Semigroup (sconcat)
import qualified Data.Text as T
@ -69,45 +70,49 @@ replmode = hledgerCommandMode
runOrReplStub :: CliOpts -> Journal -> IO ()
runOrReplStub _opts _j = return ()
-- | Default input files + InputOpts that would be used by commands if
-- there is no explicit alternative given
newtype DefaultRunJournal = DefaultRunJournal (NE.NonEmpty String)
-- | The actual run command.
run :: Maybe Journal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> IO ()
run :: Maybe DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> IO ()
run defaultJournalOverride findBuiltinCommand cliopts@CliOpts{rawopts_=rawopts} = do
withJournalCached defaultJournalOverride cliopts $ \j -> do
withJournalCached defaultJournalOverride cliopts $ \(_,key) -> do
let args = dbg1 "args" $ listofstringopt "args" rawopts
isTerminal <- hIsTerminalDevice stdin
if args == [] && not isTerminal
then runREPL j findBuiltinCommand
then runREPL key findBuiltinCommand
else do
-- Check if arguments could be interpreted as files.
-- If not, assume that they are commands specified directly on the command line
allAreFiles <- and <$> mapM (doesFileExist . snd . splitReaderPrefix) args
case allAreFiles of
True -> runFromFiles j findBuiltinCommand args
False -> runFromArgs j findBuiltinCommand args
True -> runFromFiles key findBuiltinCommand args
False -> runFromArgs key findBuiltinCommand args
-- | The actual repl command.
repl :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> IO ()
repl findBuiltinCommand cliopts = do
withJournalCached Nothing cliopts $ \j -> do
runREPL j findBuiltinCommand
withJournalCached Nothing cliopts $ \(_,key) -> do
runREPL key findBuiltinCommand
-- | Run commands from files given to "run".
runFromFiles :: Journal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromFiles defaultJrnl findBuiltinCommand inputfiles = do
runFromFiles :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromFiles defaultJournalOverride 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 defaultJrnl findBuiltinCommand . parseCommand)
forM_ commands (runCommand defaultJournalOverride findBuiltinCommand . parseCommand)
-- | Run commands from command line arguments given to "run".
runFromArgs :: Journal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromArgs defaultJrnl findBuiltinCommand args = do
runFromArgs :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromArgs defaultJournalOverride findBuiltinCommand args = do
-- read commands from all the inputfiles
let commands = dbg1 "commands from args" $ splitAtElement "--" args
forM_ commands (runCommand defaultJrnl findBuiltinCommand)
forM_ commands (runCommand defaultJournalOverride 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
@ -117,8 +122,8 @@ parseCommand line =
takeWhile (not. ((Just '#')==) . headMay) $ words' (strip line)
-- | Take a single command line (from file, or REPL, or "--"-surrounded block of the args), and run it.
runCommand :: Journal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runCommand defaultJrnl findBuiltinCommand cmdline = do
runCommand :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runCommand defaultJournalOverride findBuiltinCommand cmdline = do
dbg1IO "runCommand for" cmdline
case cmdline of
"echo":args -> putStrLn $ unwords $ args
@ -127,19 +132,19 @@ runCommand defaultJrnl findBuiltinCommand cmdline = do
Nothing -> error' $ "Unrecognized command: " ++ unwords (cmdname:args)
Just (cmdmode,cmdaction) -> do
-- Even though expandArgsAt is done by the Cli.hs, it stops at the first '--', so we need
-- to do it here as well to make sure that each command can use @ARGFILEs
-- to do it here as well to make sure that each command can use @ARGFILEs
args' <- replaceNumericFlags <$> expandArgsAt args
dbg1IO "runCommand final args" (cmdname,args')
opts <- getHledgerCliOpts' cmdmode args'
withJournalCached (Just defaultJrnl) opts $ \j -> do
withJournalCached (Just defaultJournalOverride) opts $ \(j,key) -> do
if cmdname == "run" -- allow "run" to call "run"
then run (Just j) findBuiltinCommand opts
then run (Just key) findBuiltinCommand opts
else cmdaction opts j
[] -> return ()
-- | Run an interactive REPL.
runREPL :: Journal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> IO ()
runREPL defaultJrnl findBuiltinCommand = do
runREPL :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> IO ()
runREPL defaultJournalOverride findBuiltinCommand = do
isTerminal <- hIsTerminalDevice stdin
if not isTerminal
then runInputT defaultSettings (loop "")
@ -155,30 +160,31 @@ runREPL defaultJrnl findBuiltinCommand = do
Just "quit" -> return ()
Just "exit" -> return ()
Just input -> do
liftIO $ (runCommand defaultJrnl findBuiltinCommand $ parseCommand input)
liftIO $ (runCommand defaultJournalOverride findBuiltinCommand $ parseCommand input)
`catch` (\(e::ErrorCall) -> putStr $ show e)
loop prompt
-- | Cache of all journals that have been read by commands given to "run",
-- keyed by the fully-expanded filename.
journalCache :: MVar (Map.Map String Journal)
journalCache :: MVar (Map.Map (InputOpts,PrefixedFilePath) Journal)
journalCache = unsafePerformIO $ newMVar Map.empty
{-# NOINLINE journalCache #-}
-- | Similar to `withJournal`, but uses caches all the journals it reads.
withJournalCached :: Maybe Journal -> CliOpts -> (Journal -> IO ()) -> IO ()
withJournalCached defaultJournalOverride cliopts cmd = do
j <- case defaultJournalOverride of
withJournalCached :: Maybe DefaultRunJournal -> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached defaultJournalOverride cliopts cmd = do
(j,key) <- case defaultJournalOverride of
Nothing -> journalFilePathFromOpts cliopts >>= readFiles
Just defaultJrnl -> do
Just (DefaultRunJournal defaultFiles) -> do
mbjournalpaths <- journalFilePathFromOptsNoDefault cliopts
case mbjournalpaths of
Nothing -> return defaultJrnl -- use the journal given to the "run" itself
Nothing -> readFiles defaultFiles -- use the journal(s) given to the "run" itself
Just journalpaths -> readFiles journalpaths
cmd j
cmd (j,key)
where
readFiles journalpaths =
journalTransform cliopts . sconcat <$> mapM (readAndCacheJournalFile (inputopts_ cliopts)) journalpaths
readFiles journalpaths = do
j <- journalTransform cliopts . sconcat <$> mapM (readAndCacheJournalFile (inputopts_ cliopts)) journalpaths
return (j, DefaultRunJournal journalpaths)
-- | Read a journal file, caching it if it has not been read before.
readAndCacheJournalFile :: InputOpts -> PrefixedFilePath -> IO Journal
readAndCacheJournalFile iopts fp | snd (splitReaderPrefix fp) == "-" = do
@ -188,11 +194,11 @@ withJournalCached defaultJournalOverride cliopts cmd = do
readAndCacheJournalFile iopts fp = do
dbg1IO "readAndCacheJournalFile" fp
modifyMVar journalCache $ \cache ->
case Map.lookup fp cache of
case Map.lookup (iopts,fp) cache of
Just journal -> do
dbg1IO "readAndCacheJournalFile using cache" fp
dbg1IO "readAndCacheJournalFile using cache" (fp, iopts)
return (cache, journal)
Nothing -> do
dbg1IO "readAndCacheJournalFile reading and caching journals" fp
dbg1IO "readAndCacheJournalFile reading and caching journals" (fp, iopts)
journal <- runExceptT $ readJournalFile iopts fp
either error' (\j -> return (Map.insert fp j cache, j)) journal
either error' (\j -> return (Map.insert (iopts,fp) j cache, j)) journal