run: cache all journal files, allow commands to use -f
This commit is contained in:
parent
aee85df17b
commit
32f286cc35
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
```
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user