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

imp:run,repl: allow running addon commands

Browse Source
This commit is contained in:
Simon Michael 2025-03-06 13:56:43 -10:00
parent a1a6aad873
commit cf81b042be
2 changed files with 29 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
hledger/Hledger/Cli.hs
View File

@ -422,8 +422,8 @@ main = withGhcDebug' $ do
withJournalDo opts (cmdaction opts) withJournalDo opts (cmdaction opts)
-- 6.5.4. "run" and "repl" need findBuiltinCommands passed to it to avoid circular dependency in the code -- 6.5.4. "run" and "repl" need findBuiltinCommands passed to it to avoid circular dependency in the code
| cmdname == "run" -> Hledger.Cli.Commands.Run.run Nothing findBuiltinCommand opts | cmdname == "run" -> Hledger.Cli.Commands.Run.run Nothing findBuiltinCommand addons opts
| cmdname == "repl" -> Hledger.Cli.Commands.Run.repl findBuiltinCommand opts | cmdname == "repl" -> Hledger.Cli.Commands.Run.repl findBuiltinCommand addons opts
-- 6.5.5. all other builtin commands - read the journal and if successful run the command with it -- 6.5.5. all other builtin commands - read the journal and if successful run the command with it
| otherwise -> withJournalDo opts $ cmdaction opts | otherwise -> withJournalDo opts $ cmdaction opts

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

@ -32,7 +32,7 @@ import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Extra (concatMapM) import Control.Monad.Extra (concatMapM)
import System.Exit (ExitCode) import System.Exit (ExitCode, exitWith)
import System.Console.CmdArgs.Explicit (expandArgsAt, modeNames) import System.Console.CmdArgs.Explicit (expandArgsAt, modeNames)
import System.IO (stdin, hIsTerminalDevice, hIsOpen) import System.IO (stdin, hIsTerminalDevice, hIsOpen)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
@ -41,6 +41,8 @@ import System.Console.Haskeline
import Safe (headMay) import Safe (headMay)
import Hledger.Cli.DocFiles (runTldrForPage, runInfoForTopic, runManForTopic) import Hledger.Cli.DocFiles (runTldrForPage, runInfoForTopic, runManForTopic)
import Hledger.Cli.Utils (journalTransform) import Hledger.Cli.Utils (journalTransform)
import Text.Printf (printf)
import System.Process (system)
-- | Command line options for this command. -- | Command line options for this command.
runmode = hledgerCommandMode runmode = hledgerCommandMode
@ -76,8 +78,8 @@ runOrReplStub _opts _j = return ()
newtype DefaultRunJournal = DefaultRunJournal (NE.NonEmpty String) deriving (Show) newtype DefaultRunJournal = DefaultRunJournal (NE.NonEmpty String) deriving (Show)
-- | The actual run command. -- | The actual run command.
run :: Maybe DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> IO () run :: Maybe DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> CliOpts -> IO ()
run defaultJournalOverride findBuiltinCommand cliopts@CliOpts{rawopts_=rawopts} = do run defaultJournalOverride findBuiltinCommand addons cliopts@CliOpts{rawopts_=rawopts} = do
withJournalCached defaultJournalOverride cliopts $ \(_,key) -> do withJournalCached defaultJournalOverride cliopts $ \(_,key) -> do
let args = dbg1 "args" $ listofstringopt "args" rawopts let args = dbg1 "args" $ listofstringopt "args" rawopts
isTerminal <- isStdinTerminal isTerminal <- isStdinTerminal
@ -87,37 +89,37 @@ run defaultJournalOverride findBuiltinCommand cliopts@CliOpts{rawopts_=rawopts}
let journalFromStdin = any (== "-") $ map (snd . splitReaderPrefix) $ NE.toList inputFiles let journalFromStdin = any (== "-") $ map (snd . splitReaderPrefix) $ NE.toList inputFiles
if journalFromStdin if journalFromStdin
then error' "'run' can't read commands from stdin, as one of the input files was stdin as well" then error' "'run' can't read commands from stdin, as one of the input files was stdin as well"
else runREPL key findBuiltinCommand else runREPL key findBuiltinCommand addons
else do else do
-- Check if arguments start with "--". -- Check if arguments start with "--".
-- If not, assume that they are files with commands -- If not, assume that they are files with commands
case args of case args of
"--":_ -> runFromArgs key findBuiltinCommand args "--":_ -> runFromArgs key findBuiltinCommand addons args
_ -> runFromFiles key findBuiltinCommand args _ -> runFromFiles key findBuiltinCommand addons args
-- | The actual repl command. -- | The actual repl command.
repl :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> IO () repl :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> CliOpts -> IO ()
repl findBuiltinCommand cliopts = do repl findBuiltinCommand addons cliopts = do
withJournalCached Nothing cliopts $ \(_,key) -> do withJournalCached Nothing cliopts $ \(_,key) -> do
runREPL key findBuiltinCommand runREPL key findBuiltinCommand addons
-- | Run commands from files given to "run". -- | Run commands from files given to "run".
runFromFiles :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () runFromFiles :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runFromFiles defaultJournalOverride findBuiltinCommand inputfiles = do runFromFiles defaultJournalOverride findBuiltinCommand addons inputfiles = do
dbg1IO "inputfiles" inputfiles dbg1IO "inputfiles" inputfiles
-- read commands from all the inputfiles -- read commands from all the inputfiles
commands <- (flip concatMapM) inputfiles $ \f -> do commands <- (flip concatMapM) inputfiles $ \f -> do
dbg1IO "reading commands" f dbg1IO "reading commands" f
lines . T.unpack <$> T.readFile f lines . T.unpack <$> T.readFile f
forM_ commands (runCommand defaultJournalOverride findBuiltinCommand . parseCommand) forM_ commands (runCommand defaultJournalOverride findBuiltinCommand addons . parseCommand)
-- | Run commands from command line arguments given to "run". -- | Run commands from command line arguments given to "run".
runFromArgs :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () runFromArgs :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runFromArgs defaultJournalOverride findBuiltinCommand args = do runFromArgs defaultJournalOverride findBuiltinCommand addons args = do
-- read commands from all the inputfiles -- read commands from all the inputfiles
let commands = dbg1 "commands from args" $ splitAtElement "--" args let commands = dbg1 "commands from args" $ splitAtElement "--" args
forM_ commands (runCommand defaultJournalOverride findBuiltinCommand) forM_ commands (runCommand defaultJournalOverride findBuiltinCommand addons)
-- When commands are passed on the command line, shell will parse them for us -- 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 -- When commands are read from file, we need to split the line into command and arguments
@ -127,14 +129,13 @@ parseCommand line =
takeWhile (not. ((Just '#')==) . headMay) $ words' (strip 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. -- | Take a single command line (from file, or REPL, or "--"-surrounded block of the args), and run it.
runCommand :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO () runCommand :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runCommand defaultJournalOverride findBuiltinCommand cmdline = do runCommand defaultJournalOverride findBuiltinCommand addons cmdline = do
dbg1IO "runCommand for" cmdline dbg1IO "runCommand for" cmdline
case cmdline of case cmdline of
"echo":args -> putStrLn $ unwords $ args "echo":args -> putStrLn $ unwords $ args
cmdname:args -> cmdname:args ->
case findBuiltinCommand cmdname of case findBuiltinCommand cmdname of
Nothing -> error' $ "Unrecognized command: " ++ unwords (cmdname:args)
Just (cmdmode,cmdaction) -> do Just (cmdmode,cmdaction) -> do
-- Even though expandArgsAt is done by the Cli.hs, it stops at the first '--', so we need -- 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
@ -156,13 +157,17 @@ runCommand defaultJournalOverride findBuiltinCommand cmdline = do
| otherwise -> do | otherwise -> do
withJournalCached (Just defaultJournalOverride) opts $ \(j,key) -> do withJournalCached (Just defaultJournalOverride) opts $ \(j,key) -> do
if cmdname == "run" -- allow "run" to call "run" if cmdname == "run" -- allow "run" to call "run"
then run (Just key) findBuiltinCommand opts then run (Just key) findBuiltinCommand addons opts
else cmdaction opts j else cmdaction opts j
Nothing | cmdname `elem` addons ->
system (printf "%s-%s %s" progname cmdname (unwords' args)) >>= exitWith
Nothing ->
error' $ "Unrecognized command: " ++ unwords (cmdname:args)
[] -> return () [] -> return ()
-- | Run an interactive REPL. -- | Run an interactive REPL.
runREPL :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> IO () runREPL :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runREPL defaultJournalOverride findBuiltinCommand = do runREPL defaultJournalOverride findBuiltinCommand addons = do
isTerminal <- isStdinTerminal isTerminal <- isStdinTerminal
if not isTerminal if not isTerminal
then runInputT defaultSettings (loop "") then runInputT defaultSettings (loop "")
@ -178,7 +183,7 @@ runREPL defaultJournalOverride findBuiltinCommand = do
Just "quit" -> return () Just "quit" -> return ()
Just "exit" -> return () Just "exit" -> return ()
Just input -> do Just input -> do
liftIO $ (runCommand defaultJournalOverride findBuiltinCommand $ argsAddDoubleDash $ parseCommand input) liftIO $ (runCommand defaultJournalOverride findBuiltinCommand addons $ argsAddDoubleDash $ parseCommand input)
`catches` `catches`
[Handler (\(e::ErrorCall) -> putStrLn $ rstrip $ show e) [Handler (\(e::ErrorCall) -> putStrLn $ rstrip $ show e)
,Handler (\(e::IOError) -> putStrLn $ rstrip $ show e) ,Handler (\(e::IOError) -> putStrLn $ rstrip $ show e)