From bc29e669a5788fd95908b8789b40a5c59f1394ed Mon Sep 17 00:00:00 2001 From: Ben Selfridge Date: Fri, 15 Mar 2019 15:48:12 -0700 Subject: [PATCH] Add Option to format long options with equals sign --- .gitignore | 2 ++ optparse-applicative.cabal | 2 +- src/Options/Applicative.hs | 1 + src/Options/Applicative/Builder.hs | 9 ++++++++- src/Options/Applicative/Common.hs | 7 +++++++ src/Options/Applicative/Extra.hs | 2 +- src/Options/Applicative/Help/Core.hs | 12 ++++++++++-- src/Options/Applicative/Types.hs | 3 +++ tests/long_equals.err.txt | 6 ++++++ tests/test.hs | 11 +++++++++++ 10 files changed, 50 insertions(+), 5 deletions(-) create mode 100644 tests/long_equals.err.txt diff --git a/.gitignore b/.gitignore index deb8804..e517c50 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,5 @@ cabal.project.local .cabal-sandbox/ cabal.sandbox.config + +.ghc.environment.* diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal index 0991385..eb25f8b 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -42,7 +42,7 @@ extra-source-files: CHANGELOG.md homepage: https://github.com/pcapriotti/optparse-applicative bug-reports: https://github.com/pcapriotti/optparse-applicative/issues -tested-with: +tested-with: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, diff --git a/src/Options/Applicative.hs b/src/Options/Applicative.hs index 4eeb670..4aba603 100644 --- a/src/Options/Applicative.hs +++ b/src/Options/Applicative.hs @@ -195,6 +195,7 @@ module Options.Applicative ( noBacktrack, subparserInline, columns, + helpLongEquals, defaultPrefs, -- * Completions diff --git a/src/Options/Applicative/Builder.hs b/src/Options/Applicative/Builder.hs index 48097b6..06ebfc5 100644 --- a/src/Options/Applicative/Builder.hs +++ b/src/Options/Applicative/Builder.hs @@ -85,6 +85,7 @@ module Options.Applicative.Builder ( noBacktrack, subparserInline, columns, + helpLongEquals, prefs, defaultPrefs, @@ -500,6 +501,11 @@ subparserInline = PrefsMod $ \p -> p { prefBacktrack = SubparserInline } columns :: Int -> PrefsMod columns cols = PrefsMod $ \p -> p { prefColumns = cols } +-- | Show equals sign, rather than space, in usage and help text for options with +-- long names. +helpLongEquals :: PrefsMod +helpLongEquals = PrefsMod $ \p -> p { prefHelpLongEquals = True } + -- | Create a `ParserPrefs` given a modifier prefs :: PrefsMod -> ParserPrefs prefs m = applyPrefsMod m base @@ -510,7 +516,8 @@ prefs m = applyPrefsMod m base , prefShowHelpOnError = False , prefShowHelpOnEmpty = False , prefBacktrack = Backtrack - , prefColumns = 80 } + , prefColumns = 80 + , prefHelpLongEquals = False } -- Convenience shortcuts diff --git a/src/Options/Applicative/Common.hs b/src/Options/Applicative/Common.hs index ef65acb..8ffb4c6 100644 --- a/src/Options/Applicative/Common.hs +++ b/src/Options/Applicative/Common.hs @@ -22,6 +22,7 @@ module Options.Applicative.Common ( Parser, liftOpt, showOption, + showOptionEquals, -- * Program descriptions -- @@ -65,6 +66,12 @@ showOption :: OptName -> String showOption (OptLong n) = "--" ++ n showOption (OptShort n) = '-' : [n] +-- | Like 'showOption', but puts an equals sign or a space after long options if the +-- 'ParserPrefs' indicate we should do so. +showOptionEquals :: ParserPrefs -> OptName -> String +showOptionEquals prefs (OptLong n) = "--" ++ n ++ (if prefHelpLongEquals prefs then "=" else "") +showOptionEquals _ (OptShort n) = '-' : [n] + optionNames :: OptReader a -> [OptName] optionNames (OptReader names _ _) = names optionNames (FlagReader names _) = names diff --git a/src/Options/Applicative/Extra.hs b/src/Options/Applicative/Extra.hs index e9a668d..990b9b3 100644 --- a/src/Options/Applicative/Extra.hs +++ b/src/Options/Applicative/Extra.hs @@ -258,7 +258,7 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn -> -- reader also ensure that it can be immediately -- reachable from where the error was given. opt_completions hinfo opt = case optMain opt of - OptReader ns _ _ -> fmap showOption ns + OptReader ns _ _ -> fmap (showOptionEquals pprefs) ns FlagReader ns _ -> fmap showOption ns ArgReader _ -> [] CmdReader _ ns _ | hinfoUnreachableArgs hinfo diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 96e46c1..6a4758c 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -37,8 +37,16 @@ optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, optDesc pprefs style info opt = let ns = optionNames $ optMain opt mv = stringChunk $ optMetaVar opt - descs = map (string . showOption) (sort ns) - desc = listToChunk (intersperse (descSep style) descs) <<+>> mv + has_arg = case mv of + Chunk Nothing -> True + _ -> False + descs | has_arg = map (string . showOption) (sort ns) + | otherwise = map (string . showOptionEquals pprefs) (sort ns) + isLong (OptLong _) = True + isLong _ = False + has_equals = any isLong ns && prefHelpLongEquals pprefs + desc | has_equals = listToChunk (intersperse (descSep style) descs) <> mv + | otherwise = listToChunk (intersperse (descSep style) descs) <<+>> mv show_opt | optVisibility opt == Hidden = descHidden style diff --git a/src/Options/Applicative/Types.hs b/src/Options/Applicative/Types.hs index 3dc71b4..0c5c851 100644 --- a/src/Options/Applicative/Types.hs +++ b/src/Options/Applicative/Types.hs @@ -117,6 +117,9 @@ data ParserPrefs = ParserPrefs -- subcommand fails (default: Backtrack) , prefColumns :: Int -- ^ number of columns in the terminal, used to -- format the help page (default: 80) + , prefHelpLongEquals :: Bool -- ^ when displaying long names in usage and help, + -- use an '=' sign for long names, rather than a + -- single space (default: False) } deriving (Eq, Show) data OptName = OptShort !Char diff --git a/tests/long_equals.err.txt b/tests/long_equals.err.txt new file mode 100644 index 0000000..3064350 --- /dev/null +++ b/tests/long_equals.err.txt @@ -0,0 +1,6 @@ +Usage: long_equals (-i|-j|--intval=|--intval2=ARG) + +Available options: + -i,-j,--intval=,--intval2=ARG + integer value + -h,--help Show this help text diff --git a/tests/test.hs b/tests/test.hs index a008c94..fef815d 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -202,6 +202,17 @@ prop_nested_optional_help = once $ i = info (p <**> helper) idm in checkHelpText "nested_optional" i ["--help"] +prop_long_equals :: Property +prop_long_equals = once $ + let p :: Parser String + p = option auto (long "intval" + <> short 'j' + <> long "intval2" + <> short 'i' + <> help "integer value") + i = info (p <**> helper) fullDesc + in checkHelpTextWith ExitSuccess (prefs helpLongEquals) "long_equals" i ["--help"] + prop_nested_fun :: Property prop_nested_fun = once $ let p :: Parser (String, Maybe (String, Maybe String))