hledger: long --help flag shows man page
hledger now embeds its man page, and will display it on --help (like Ledger and git). -h and --help are now different, like git.
This commit is contained in:
Simon Michael
parent
bfa5e14373
commit
48f89314d5
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TemplateHaskell #-}
|
||||
{-|
|
||||
|
||||
Common cmdargs modes and flags, a command-line options type, and
|
||||
@ -21,6 +21,7 @@ module Hledger.Cli.CliOptions (
|
||||
defCommandMode,
|
||||
defAddonCommandMode,
|
||||
argsFlag,
|
||||
showModeUsage,
|
||||
showModeHelp,
|
||||
withAliases,
|
||||
|
||||
@ -64,6 +65,9 @@ import Prelude ()
|
||||
import Prelude.Compat
|
||||
import qualified Control.Exception as C
|
||||
import Control.Monad (when)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.UTF8 as BS8
|
||||
import Data.FileEmbed
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Functor.Compat ((<$>))
|
||||
#endif
|
||||
@ -93,7 +97,8 @@ import Hledger.Cli.Version
|
||||
-- | Common help flags: --help, --debug, --version...
|
||||
helpflags :: [Flag RawOpts]
|
||||
helpflags = [
|
||||
flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help"
|
||||
flagNone ["h"] (setboolopt "shorthelp") "show general usage or (after command) command usage"
|
||||
,flagNone ["help"] (setboolopt "longhelp") "show detailed help"
|
||||
-- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
|
||||
,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show increasing amounts of debug output if N is 1-9. With no argument, show level 1"
|
||||
,flagNone ["version"] (setboolopt "version") "show version information"
|
||||
@ -166,7 +171,7 @@ defMode = Mode {
|
||||
,modeGroupFlags = Group {
|
||||
groupNamed = []
|
||||
,groupUnnamed = [
|
||||
flagNone ["help","h","?"] (setboolopt "help") "Show command help."
|
||||
flagNone ["h"] (setboolopt "shorthelp") "Show command help."
|
||||
]
|
||||
,groupHidden = []
|
||||
}
|
||||
@ -222,11 +227,19 @@ standardAddonsHelp = [
|
||||
,("addon9", "dummy add-on command for testing")
|
||||
]
|
||||
|
||||
-- | Get a mode's help message as a nicely wrapped string.
|
||||
showModeHelp :: Mode a -> String
|
||||
showModeHelp = (showText defaultWrap :: [Text] -> String) .
|
||||
-- | Get a mode's usage message as a nicely wrapped string.
|
||||
showModeUsage :: Mode a -> String
|
||||
showModeUsage = (showText defaultWrap :: [Text] -> String) .
|
||||
(helpText [] HelpFormatDefault :: Mode a -> [Text])
|
||||
|
||||
hledgerManual :: BS.ByteString
|
||||
hledgerManual = $(embedFile "doc/hledger.1.txt")
|
||||
|
||||
-- | Get the hledger long help, ready for console output
|
||||
-- (currently, the hledger.1 man page formatted for 80 columns).
|
||||
showModeHelp :: Mode a -> String
|
||||
showModeHelp _ = BS8.toString hledgerManual
|
||||
|
||||
-- | Add command aliases to the command's help string.
|
||||
withAliases :: String -> [String] -> String
|
||||
s `withAliases` [] = s
|
||||
@ -348,8 +361,8 @@ getCliOpts mode' = do
|
||||
opts <- rawOptsToCliOpts rawopts
|
||||
debugArgs args' opts
|
||||
-- if any (`elem` args) ["--help","-h","-?"]
|
||||
when ("help" `inRawOpts` rawopts_ opts) $
|
||||
putStr (showModeHelp mode') >> exitSuccess
|
||||
when ("shorthelp" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess
|
||||
when ("longhelp" `inRawOpts` rawopts_ opts) $ putStr (showModeHelp mode') >> exitSuccess
|
||||
return opts
|
||||
where
|
||||
-- | Print debug info about arguments and options if --debug is present.
|
||||
|
||||
@ -242,12 +242,16 @@ main = do
|
||||
isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
|
||||
isExternalCommand = not (null cmd) && cmd `elem` addonPreciseNames -- probably
|
||||
isBadCommand = not (null rawcmd) && null cmd
|
||||
hasHelp args = any (`elem` args) ["--help","-h","-?"]
|
||||
hasVersion = ("--version" `elem`)
|
||||
hasDetailedVersion = ("--version+" `elem`)
|
||||
generalUsage = putStr $ showModeUsage $ mainmode addonDisplayNames
|
||||
generalHelp = putStr $ showModeHelp $ mainmode addonDisplayNames
|
||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
|
||||
f `orShowHelp` mode = if hasHelp args then putStr (showModeHelp mode) else f
|
||||
hasShortHelp args = any (`elem` args) ["-h"]
|
||||
hasLongHelp args = any (`elem` args) ["--help"]
|
||||
hasHelp args = hasShortHelp args || hasLongHelp args
|
||||
f `orShowUsage` mode = if hasShortHelp args then putStr (showModeUsage mode) else f
|
||||
f `orShowHelp` mode = if hasLongHelp args then putStr (showModeHelp mode) else f
|
||||
dbgIO "processed opts" opts
|
||||
dbgIO "command matched" cmd
|
||||
dbgIO "isNullCommand" isNullCommand
|
||||
@ -261,28 +265,29 @@ main = do
|
||||
let
|
||||
runHledgerCommand
|
||||
-- high priority flags and situations. --help should be highest priority.
|
||||
| hasHelp argsbeforecmd = dbgIO "" "--help before command, showing general help" >> generalHelp
|
||||
| hasShortHelp argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> generalUsage
|
||||
| hasLongHelp argsbeforecmd = dbgIO "" "--help before command, showing general help" >> generalHelp
|
||||
| not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
|
||||
= putStrLn prognameandversion
|
||||
| not (hasHelp argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand))
|
||||
= putStrLn prognameanddetailedversion
|
||||
-- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname
|
||||
-- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show)
|
||||
| isNullCommand = dbgIO "" "no command, showing general help" >> generalHelp
|
||||
| isNullCommand = dbgIO "" "no command, showing general help" >> generalUsage
|
||||
| isBadCommand = badCommandError
|
||||
|
||||
-- internal commands
|
||||
| cmd == "activity" = withJournalDo opts histogram `orShowHelp` activitymode
|
||||
| cmd == "add" = (journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) >> withJournalDo opts add) `orShowHelp` addmode
|
||||
| cmd == "accounts" = withJournalDo opts accounts `orShowHelp` accountsmode
|
||||
| cmd == "balance" = withJournalDo opts balance `orShowHelp` balancemode
|
||||
| cmd == "balancesheet" = withJournalDo opts balancesheet `orShowHelp` balancesheetmode
|
||||
| cmd == "cashflow" = withJournalDo opts cashflow `orShowHelp` cashflowmode
|
||||
| cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
|
||||
| cmd == "print" = withJournalDo opts print' `orShowHelp` printmode
|
||||
| cmd == "register" = withJournalDo opts register `orShowHelp` registermode
|
||||
| cmd == "stats" = withJournalDo opts stats `orShowHelp` statsmode
|
||||
| cmd == "test" = test' opts `orShowHelp` testmode
|
||||
| cmd == "activity" = withJournalDo opts histogram `orShowUsage` activitymode `orShowHelp` activitymode
|
||||
| cmd == "add" = (journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) >> withJournalDo opts add) `orShowUsage` addmode `orShowHelp` addmode
|
||||
| cmd == "accounts" = withJournalDo opts accounts `orShowUsage` accountsmode `orShowHelp` accountsmode
|
||||
| cmd == "balance" = withJournalDo opts balance `orShowUsage` balancemode `orShowHelp` balancemode
|
||||
| cmd == "balancesheet" = withJournalDo opts balancesheet `orShowUsage` balancesheetmode `orShowHelp` balancesheetmode
|
||||
| cmd == "cashflow" = withJournalDo opts cashflow `orShowUsage` cashflowmode `orShowHelp` cashflowmode
|
||||
| cmd == "incomestatement" = withJournalDo opts incomestatement `orShowUsage` incomestatementmode `orShowHelp` incomestatementmode
|
||||
| cmd == "print" = withJournalDo opts print' `orShowUsage` printmode `orShowHelp` printmode
|
||||
| cmd == "register" = withJournalDo opts register `orShowUsage` registermode `orShowHelp` registermode
|
||||
| cmd == "stats" = withJournalDo opts stats `orShowUsage` statsmode `orShowHelp` statsmode
|
||||
| cmd == "test" = test' opts `orShowUsage` testmode `orShowHelp` testmode
|
||||
|
||||
-- an external command
|
||||
| isExternalCommand = do
|
||||
|
||||
@ -63,11 +63,13 @@ dependencies:
|
||||
- hledger-lib == 0.27
|
||||
- base >= 4.3 && < 5
|
||||
- base-compat >= 0.8.1
|
||||
- bytestring
|
||||
- containers
|
||||
- unordered-containers
|
||||
- cmdargs >= 0.10 && < 0.11
|
||||
- csv
|
||||
- directory
|
||||
- file-embed
|
||||
- filepath
|
||||
- haskeline >= 0.6 && <= 0.8
|
||||
- HUnit
|
||||
|
||||
@ -61,11 +61,13 @@ library
|
||||
hledger-lib == 0.27
|
||||
, base >= 4.3 && < 5
|
||||
, base-compat >= 0.8.1
|
||||
, bytestring
|
||||
, containers
|
||||
, unordered-containers
|
||||
, cmdargs >= 0.10 && < 0.11
|
||||
, csv
|
||||
, directory
|
||||
, file-embed
|
||||
, filepath
|
||||
, haskeline >= 0.6 && <= 0.8
|
||||
, HUnit
|
||||
@ -135,11 +137,13 @@ executable hledger
|
||||
hledger-lib == 0.27
|
||||
, base >= 4.3 && < 5
|
||||
, base-compat >= 0.8.1
|
||||
, bytestring
|
||||
, containers
|
||||
, unordered-containers
|
||||
, cmdargs >= 0.10 && < 0.11
|
||||
, csv
|
||||
, directory
|
||||
, file-embed
|
||||
, filepath
|
||||
, haskeline >= 0.6 && <= 0.8
|
||||
, HUnit
|
||||
@ -188,11 +192,13 @@ test-suite test
|
||||
hledger-lib == 0.27
|
||||
, base >= 4.3 && < 5
|
||||
, base-compat >= 0.8.1
|
||||
, bytestring
|
||||
, containers
|
||||
, unordered-containers
|
||||
, cmdargs >= 0.10 && < 0.11
|
||||
, csv
|
||||
, directory
|
||||
, file-embed
|
||||
, filepath
|
||||
, haskeline >= 0.6 && <= 0.8
|
||||
, HUnit
|
||||
@ -249,6 +255,7 @@ benchmark bench
|
||||
tabular >= 0.2 && < 0.3,
|
||||
timeit,
|
||||
process,
|
||||
file-embed,
|
||||
filepath,
|
||||
directory
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user