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

run: support --man, --info, --tldr

Browse Source
This commit is contained in:
Dmitry Astapov 2025-03-06 21:35:45 +00:00 committed by Simon Michael
parent 7fdb2f7fe6
commit 758335daf0
1 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,11 +33,13 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad.Extra (concatMapM) import Control.Monad.Extra (concatMapM)
import System.Exit (ExitCode) import System.Exit (ExitCode)
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)
import System.Console.Haskeline import System.Console.Haskeline
import Safe (headMay) import Safe (headMay)
import Hledger.Cli.DocFiles (runTldrForPage, runInfoForTopic, runManForTopic)
import Hledger.Cli.Utils (journalTransform) import Hledger.Cli.Utils (journalTransform)
-- | Command line options for this command. -- | Command line options for this command.
@ -134,15 +136,28 @@ runCommand defaultJournalOverride findBuiltinCommand cmdline = do
case findBuiltinCommand cmdname of case findBuiltinCommand cmdname of
Nothing -> error' $ "Unrecognized command: " ++ unwords (cmdname:args) 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
args' <- replaceNumericFlags <$> expandArgsAt args args' <- replaceNumericFlags <$> expandArgsAt args
dbg1IO "runCommand final args" (cmdname,args') dbg1IO "runCommand final args" (cmdname,args')
opts <- getHledgerCliOpts' cmdmode args' opts <- getHledgerCliOpts' cmdmode args'
withJournalCached (Just defaultJournalOverride) opts $ \(j,key) -> do let
if cmdname == "run" -- allow "run" to call "run" rawopts = rawopts_ opts
then run (Just key) findBuiltinCommand opts mmodecmdname = headMay $ modeNames cmdmode
else cmdaction opts j helpFlag = boolopt "help" rawopts
tldrFlag = boolopt "tldr" rawopts
infoFlag = boolopt "info" rawopts
manFlag = boolopt "man" rawopts
if
| helpFlag -> runPager $ showModeUsage cmdmode ++ "\n"
| tldrFlag -> runTldrForPage $ maybe "hledger" (("hledger-"<>)) mmodecmdname
| infoFlag -> runInfoForTopic "hledger" mmodecmdname
| manFlag -> runManForTopic "hledger" mmodecmdname
| otherwise -> do
withJournalCached (Just defaultJournalOverride) opts $ \(j,key) -> do
if cmdname == "run" -- allow "run" to call "run"
then run (Just key) findBuiltinCommand opts
else cmdaction opts j
[] -> return () [] -> return ()
-- | Run an interactive REPL. -- | Run an interactive REPL.