diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b80d0ae..32cccb05 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ - Add `commandWithAliases` for defining multiple aliases for the same command. +- Add `briefDescOpt` for styling the brief help options. + ## Version 0.19.0.0 (03 June 2025) - Add `briefHangPoint` modifier. This allows one to specify the command length diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal index 8471b933..82a41fa1 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -44,6 +44,8 @@ extra-source-files: CHANGELOG.md tests/parser_group_command_groups.err.txt tests/parser_group_duplicate_command_groups.err.txt tests/parser_group_duplicates.err.txt + tests/parser_group_nested_desc_opt_groups.err.txt + tests/parser_group_nested_desc_opt_groups_style.err.txt tests/parser_group_nested.err.txt tests/prop_cmd_alias_dupes.err.txt tests/prop_cmd_aliases.err.txt @@ -151,6 +153,8 @@ test-suite tests , Examples.ParserGroup.DuplicateCommandGroups , Examples.ParserGroup.Duplicates , Examples.ParserGroup.Nested + , Examples.ParserGroup.NestedDescOptGroups + , Examples.ParserGroup.NestedDescOptGroupsStyle build-depends: base , optparse-applicative diff --git a/src/Options/Applicative.hs b/src/Options/Applicative.hs index 3c0df53d..34fb8d24 100644 --- a/src/Options/Applicative.hs +++ b/src/Options/Applicative.hs @@ -202,8 +202,12 @@ module Options.Applicative ( helpShowGlobals, helpIndent, briefHangPoint, + briefDescOpt, defaultPrefs, + -- ** Brief Description + BriefDescOpt (..), + -- * Completions -- -- | optparse-applicative supplies a rich completion system for bash, diff --git a/src/Options/Applicative/Builder.hs b/src/Options/Applicative/Builder.hs index 74f06335..fdba8286 100644 --- a/src/Options/Applicative/Builder.hs +++ b/src/Options/Applicative/Builder.hs @@ -90,6 +90,7 @@ module Options.Applicative.Builder ( helpShowGlobals, helpIndent, briefHangPoint, + briefDescOpt, prefs, defaultPrefs, @@ -602,6 +603,11 @@ helpIndent w = PrefsMod $ \p -> p { prefTabulateFill = w } briefHangPoint :: Int -> PrefsMod briefHangPoint php = PrefsMod $ \p -> p { prefBriefHangPoint = php } +-- | Set the brief option description style. +-- +-- @since 0.20.0.0 +briefDescOpt :: BriefDescOpt -> PrefsMod +briefDescOpt d = PrefsMod $ \p -> p { prefBriefDescOpt = d } -- | Create a `ParserPrefs` given a modifier prefs :: PrefsMod -> ParserPrefs @@ -617,7 +623,8 @@ prefs m = applyPrefsMod m base , prefHelpLongEquals = False , prefHelpShowGlobal = False , prefTabulateFill = 24 - , prefBriefHangPoint = 35 } + , prefBriefHangPoint = 35 + , prefBriefDescOpt = BriefDescOptList } -- Convenience shortcuts diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 50328bb0..c1323a93 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -19,7 +19,7 @@ module Options.Applicative.Help.Core ( ) where import Control.Applicative -import Control.Monad (guard) +import Control.Monad (guard, join) import Data.Foldable (any, foldl') import Data.Function (on) @@ -34,6 +34,7 @@ import Options.Applicative.Common import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk +import qualified Options.Applicative.Internal as Internal -- | Style for rendering an option. data OptDescStyle @@ -53,7 +54,7 @@ optDesc pprefs style _reachability opt = List.sort . optionNames . optMain $ opt meta = stringChunk $ optMetaVar opt - grp = propGroup $ optProps opt + grp = optToGroup opt descs = map (pretty . showOption) names descriptions = @@ -117,12 +118,24 @@ missingDesc = briefDesc' False -- | Generate a brief help text for a parser, allowing the specification -- of if optional arguments are show. briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc -briefDesc' showOptional pprefs = +briefDesc' showOptional pprefs p = wrapOver NoDefault MaybeRequired . foldTree pprefs style . mFilterOptional + . addGroupsFn . treeMapParser optDesc' + $ p' where + -- (Filtered parser, add groups function) + (p', addGroupsFn) = case prefBriefDescOpt pprefs of + -- Normal: do not filter parser, and do not add groups. + BriefDescOptList -> (p, id) + -- For both group options, filter the tree such that all options/flags + -- are removed. Then return a function that adds the group names to + -- the OptTree, to be rendered in front of the rest of the tree. + BriefDescOptGroups optPrefs -> + (Internal.filterParserOptions isNotOpt p, addGroups optPrefs p) + mFilterOptional | showOptional = id @@ -140,6 +153,47 @@ briefDesc' showOptional pprefs = in (a, b) + -- Adds groups in front of the rest of the tree as single leaves. + addGroups :: + -- Optional style function. + Maybe (String -> Maybe Doc) -> + Parser a -> + OptTree (Chunk Doc, Parenthetic) -> + OptTree (Chunk Doc, Parenthetic) + addGroups optStyle pGroups tr = case tr of + n@(Leaf _) -> MultNode (nodes ++ [n]) + MultNode xs -> MultNode (nodes ++ xs) + n@(AltNode {}) -> MultNode (nodes ++ [n]) + n@(BindNode {}) -> MultNode (nodes ++ [n]) + where + groups = allOptionGroups pGroups + nodes = fmap (groupNameToNode optStyle) groups + + -- Turns a single group name into an OptTree doc, styling as requested. + groupNameToNode :: Maybe (String -> Maybe Doc) -> String -> OptTree (Chunk Doc, Parenthetic) + groupNameToNode styleGroups = + Leaf + -- The Parenthetic value here actually isn't used, since these + -- are leaves. Potential bracketing and other styling is handled by + -- the param function. + . (\x -> (x,NeverRequired)) + . Chunk + . fromMaybe defStyleGroups styleGroups + + isNotOpt opt = case optMain opt of + OptReader {} -> False + FlagReader {} -> False + _ -> True + + defStyleGroups :: String -> Maybe Doc + defStyleGroups = Just . brackets . pretty . dropColon + where + -- Default style adds brackets and drops a trailing colon if it exists + -- e.g. "Available options:" -> "[Available options]". + dropColon [] = [] + dropColon [':'] = [] + dropColon (x : xs) = x : dropColon xs + -- | Wrap a doc in parentheses or brackets if required. wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc wrapOver altnode mustWrapBeyond (chunk, wrapping) @@ -205,15 +259,15 @@ optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc optionsDesc global pprefs p = vsepChunks . formatTitle' - . fmap tabulateGroup + . fmap (tabulateGroup . NE.toList) . groupByTitle $ docs where docs :: [Maybe (OptGroup, (Doc, Doc))] docs = mapParser doc p - groupByTitle :: [Maybe (OptGroup, (Doc, Doc))] -> [[(OptGroup, (Doc, Doc))]] - groupByTitle xs = groupFstAll . catMaybes $ xs + groupByTitle :: [Maybe (OptGroup, (Doc, Doc))] -> [NonEmpty (OptGroup, (Doc, Doc))] + groupByTitle = groupFstAll . catMaybes -- NOTE: [Nested group alignment] -- @@ -307,10 +361,7 @@ optionsDesc global pprefs p = Nothing -> ([], defTitle) Just (parentGrps, grp) -> (parentGrps, grp) - defTitle = - if global - then "Global options:" - else "Available options:" + defTitle = mkDefTitle global maxGroupLevel :: Int maxGroupLevel = findMaxGroupLevel docs @@ -362,6 +413,12 @@ optionsDesc global pprefs p = lvlIndent :: Int lvlIndent = 2 +mkDefTitle :: Bool -> String +mkDefTitle global = + if global + then "Global options:" + else "Available options:" + errorHelp :: Chunk Doc -> ParserHelp errorHelp chunk = mempty { helpError = chunk } @@ -394,7 +451,7 @@ parserHelp pprefs p = : (group_title <$> cs) where def = "Available commands:" - cs = groupFstAll $ cmdDesc pprefs p + cs = fmap NE.toList $ groupFstAll $ cmdDesc pprefs p group_title a@((n, _) : _) = with_title (fromMaybe def n) $ @@ -437,6 +494,39 @@ data Parenthetic -- ^ Parenthesis should always be used. deriving (Eq, Ord, Show) +optToGroup :: Option a -> OptGroup +optToGroup = propGroup . optProps + +-- | Returns all groups associated to this option. Returns +-- [default_group_name] if there are none. Hence this is morally +-- NonEmpty, though we return List since our immediate usage requires a +-- List. +optGroupToNames :: OptGroup -> [String] +optGroupToNames (OptGroup xs) = case xs of + [] -> [mkDefTitle False] + ys -> ys + +-- Given a parser, returns a list of all option groups. This includes groups +-- that do not have any bare options themselves i.e. they only contain +-- other groups. +-- +-- If we wanted to return only those groups that directly contained /some/ +-- options, we'd instead do 'getOptionGroups optGroupToName id', where +-- +-- optGroupToName :: OptGroup -> String +-- optGroupToName = -- returns the last group name or default. +allOptionGroups :: Parser a -> [String] +allOptionGroups = getOptionGroups optGroupToNames join + +getOptionGroups :: (OptGroup -> b) -> ([b] -> [String]) -> Parser a -> [String] +getOptionGroups toGroup toStrs = + fmap NE.head + . groupAllOn id + . toStrs + . mapParser go + where + go = const (toGroup . optToGroup) + -- | Groups on the first element of the tuple. This differs from the simple -- @groupBy ((==) `on` fst)@ in that non-adjacent groups are __also__ grouped -- together. For example: @@ -454,35 +544,34 @@ data Parenthetic -- the first element. -- -- @since 0.19.0.0 -groupFstAll :: Ord a => [(a, b)] -> [[(a, b)]] -groupFstAll = +groupFstAll :: Ord a => [(a, b)] -> [NonEmpty (a, b)] +groupFstAll = groupAllOn fst + +groupAllOn :: Ord b => (a -> b) -> [a] -> [NonEmpty a] +groupAllOn f = -- In order to group all (adjacent + non-adjacent) Eq elements together, we -- sort the list so that the Eq elements are in fact adjacent, _then_ group. -- We don't want to destroy the original order, however, so we add a -- temporary index that maintains this original order. The full logic is: -- -- 1. Add index i that preserves original order. - -- 2. Sort on tuple's fst. - -- 3. Group by fst. + -- 2. Sort on function. + -- 3. Group on function. -- 4. Sort by i, restoring original order. -- 5. Drop index i. - fmap (NE.toList . dropIdx) + fmap dropIdx . List.sortOn toIdx - . NE.groupBy ((==) `on` fst') - . List.sortOn fst' + . NE.groupBy ((==) `on` f . snd) + . List.sortOn (f . snd) . zipWithIndex where - dropIdx :: NonEmpty (Int, (a, b)) -> NonEmpty (a, b) + dropIdx :: NonEmpty (Int, a) -> NonEmpty a dropIdx = fmap snd - toIdx :: NonEmpty (Int, (a, b)) -> Int + toIdx :: NonEmpty (Int, a) -> Int toIdx ((x, _) :| _) = x - -- Like fst, ignores our added index - fst' :: (Int, (a, b)) -> a - fst' (_, (x, _)) = x - - zipWithIndex :: [(a, b)] -> [(Int, (a, b))] + zipWithIndex :: [a] -> [(Int, a)] zipWithIndex = zip [1 ..] -- | From base-4.19.0.0. diff --git a/src/Options/Applicative/Internal.hs b/src/Options/Applicative/Internal.hs index 625f1ab6..13fabc3f 100644 --- a/src/Options/Applicative/Internal.hs +++ b/src/Options/Applicative/Internal.hs @@ -28,6 +28,7 @@ module Options.Applicative.Internal , disamb , mapParserOptions + , filterParserOptions ) where import Control.Applicative @@ -293,3 +294,19 @@ mapParserOptions f = go go (MultP p1 p2) = MultP (go p1) (go p2) go (AltP p1 p2) = AltP (go p1) (go p2) go (BindP p1 p2) = BindP (go p1) (\x -> go (p2 x)) + +-- | Filters the parser based on its options. +-- +-- @since 0.20.0.0 +filterParserOptions :: (forall x. Option x -> Bool) -> Parser a -> Parser a +filterParserOptions f = go + where + go :: forall y. Parser y -> Parser y + go (NilP x) = NilP x + go opt@(OptP o) = + if f o + then opt + else NilP Nothing + go (MultP p1 p2) = MultP (go p1) (go p2) + go (AltP p1 p2) = AltP (go p1) (go p2) + go (BindP p1 p2) = BindP (go p1) (\x -> go (p2 x)) diff --git a/src/Options/Applicative/Types.hs b/src/Options/Applicative/Types.hs index 2963dd78..0296085f 100644 --- a/src/Options/Applicative/Types.hs +++ b/src/Options/Applicative/Types.hs @@ -3,6 +3,7 @@ module Options.Applicative.Types ( ParseError(..), ParserInfo(..), ParserPrefs(..), + BriefDescOpt (..), Option(..), OptName(..), @@ -148,8 +149,37 @@ data ParserPrefs = ParserPrefs -- section (default: False) , prefTabulateFill ::Int -- ^ Indentation width for tables , prefBriefHangPoint :: Int -- ^ Width at which to hang the brief description + , prefBriefDescOpt :: BriefDescOpt -- ^ Styles the brief option description } deriving (Eq, Show) +-- | How to style options in the brief description. +-- +-- @since 0.20.0.0 +data BriefDescOpt + -- | Lists all option groups. The parameter function is used to style + -- the group names. Groups can be omitted by returning 'Nothing'. + -- + -- If no function is provided, a default style is applied, which adds + -- brackets and drops a trailing colon. + -- + -- @since 0.20.0.0 + = BriefDescOptGroups (Maybe (String -> Maybe Doc)) + -- | Lists all options individually. This is the default. + -- + -- @since 0.20.0.0 + | BriefDescOptList + +instance Show BriefDescOpt where + show (BriefDescOptGroups Nothing) = "BriefDescOptGroups Nothing" + show (BriefDescOptGroups (Just _)) = "BriefDescOptGroups (Just _)" + show BriefDescOptList = "BriefDescOptList" + +instance Eq BriefDescOpt where + BriefDescOptGroups Nothing == BriefDescOptGroups Nothing = True + BriefDescOptGroups (Just _) == BriefDescOptGroups (Just _) = True + BriefDescOptList == BriefDescOptList = True + _ == _ = False + data OptName = OptShort !Char | OptLong !String deriving (Eq, Ord, Show) diff --git a/tests/Examples/ParserGroup/NestedDescOptGroups.hs b/tests/Examples/ParserGroup/NestedDescOptGroups.hs new file mode 100644 index 00000000..6eea7a1a --- /dev/null +++ b/tests/Examples/ParserGroup/NestedDescOptGroups.hs @@ -0,0 +1,139 @@ +module Examples.ParserGroup.NestedDescOptGroups (opts, myPrefs, main) where + +import Data.Semigroup ((<>)) +import Options.Applicative + +-- Nested groups. Demonstrates that group can nest. + +data LogGroup = LogGroup + { logPath :: Maybe String, + systemGroup :: SystemGroup, + logVerbosity :: Maybe Int + } + deriving (Show) + +data SystemGroup = SystemGroup + { poll :: Bool, + deepNested :: Nested2, + timeout :: Int + } + deriving (Show) + +data Nested2 = Nested2 + { nested2Str :: String, + nested3 :: Nested3 + } + deriving (Show) + +newtype Nested3 = Nested3 + { nested3Str :: String + } + deriving (Show) + +data Sample = Sample + { hello :: String, + logGroup :: LogGroup, + quiet :: Bool, + verbosity :: Int, + group2 :: (Int, Int), + cmd :: String + } + deriving (Show) + +sample :: Parser Sample +sample = + Sample + <$> parseHello + <*> parseLogGroup + <*> parseQuiet + <*> parseVerbosity + <*> parseGroup2 + <*> parseCmd + + where + parseHello = + strOption + ( long "hello" + <> metavar "TARGET" + <> help "Target for the greeting" + ) + + parseLogGroup = + parserOptionGroup "First group" $ + parserOptionGroup "Second group" $ + parserOptionGroup "Logging" $ + LogGroup + <$> parseLogPath + <*> parseSystemGroup + <*> parseLogVerbosity + + where + parseLogPath = + optional + ( strOption + ( long "file-log-path" + <> metavar "PATH" + <> help "Log file path" + ) + ) + parseLogVerbosity = + optional + ( option + auto + ( long "file-log-verbosity" + <> metavar "INT" + <> help "File log verbosity" + ) + ) + + parseQuiet = + switch + ( long "quiet" + <> short 'q' + <> help "Whether to be quiet" + ) + + parseSystemGroup = + parserOptionGroup "System Options" $ + SystemGroup + <$> switch (long "poll" <> help "Whether to poll") + <*> parseNested2 + <*> option auto (long "timeout" <> metavar "INT" <> help "Whether to time out") + + parseNested2 = + parserOptionGroup "Nested2" $ + Nested2 + <$> option auto (long "double-nested" <> metavar "STR" <> help "Some nested option") + <*> parseNested3 + + parseNested3 = + parserOptionGroup "Nested3" $ + Nested3 <$> option auto (long "triple-nested" <> metavar "STR" <> help "Another option") + + parseGroup2 :: Parser (Int, Int) + parseGroup2 = parserOptionGroup "Group 2" $ + (,) + <$> parserOptionGroup "G 2.1" (option auto (long "one" <> help "Option 1")) + <*> parserOptionGroup "G 2.2" (option auto (long "two" <> help "Option 2")) + + parseVerbosity = + option auto (long "verbosity" <> short 'v' <> help "Console verbosity") + + parseCmd = + argument str (metavar "Command") + +opts :: ParserInfo Sample +opts = + info + (sample <**> helper) + ( progDesc "Nested parser groups" + <> header "parser_group.nested_desc_opt_groups - a test for optparse-applicative" + ) + +main :: IO () +main = do + r <- customExecParser myPrefs opts + print r + +myPrefs :: ParserPrefs +myPrefs = prefs (helpShowGlobals <> briefDescOpt (BriefDescOptGroups Nothing)) diff --git a/tests/Examples/ParserGroup/NestedDescOptGroupsStyle.hs b/tests/Examples/ParserGroup/NestedDescOptGroupsStyle.hs new file mode 100644 index 00000000..bbce80c5 --- /dev/null +++ b/tests/Examples/ParserGroup/NestedDescOptGroupsStyle.hs @@ -0,0 +1,154 @@ +module Examples.ParserGroup.NestedDescOptGroupsStyle (opts, myPrefs, main) where + +import qualified Data.Char as Ch +import Data.Semigroup ((<>)) +import Options.Applicative +import Options.Applicative.Help (Doc) +import qualified Options.Applicative.Help.Pretty as Doc + +-- Nested groups. Demonstrates that group can nest. + +data LogGroup = LogGroup + { logPath :: Maybe String, + systemGroup :: SystemGroup, + logVerbosity :: Maybe Int + } + deriving (Show) + +data SystemGroup = SystemGroup + { poll :: Bool, + deepNested :: Nested2, + timeout :: Int + } + deriving (Show) + +data Nested2 = Nested2 + { nested2Str :: String, + nested3 :: Nested3 + } + deriving (Show) + +newtype Nested3 = Nested3 + { nested3Str :: String + } + deriving (Show) + +data Sample = Sample + { hello :: String, + logGroup :: LogGroup, + quiet :: Bool, + verbosity :: Int, + group2 :: (Int, Int), + cmd :: String + } + deriving (Show) + +sample :: Parser Sample +sample = + Sample + <$> parseHello + <*> parseLogGroup + <*> parseQuiet + <*> parseVerbosity + <*> parseGroup2 + <*> parseCmd + + where + parseHello = + strOption + ( long "hello" + <> metavar "TARGET" + <> help "Target for the greeting" + ) + + parseLogGroup = + parserOptionGroup "First group" $ + parserOptionGroup "Second group" $ + parserOptionGroup "Logging" $ + LogGroup + <$> parseLogPath + <*> parseSystemGroup + <*> parseLogVerbosity + + where + parseLogPath = + optional + ( strOption + ( long "file-log-path" + <> metavar "PATH" + <> help "Log file path" + ) + ) + parseLogVerbosity = + optional + ( option + auto + ( long "file-log-verbosity" + <> metavar "INT" + <> help "File log verbosity" + ) + ) + + parseQuiet = + switch + ( long "quiet" + <> short 'q' + <> help "Whether to be quiet" + ) + + parseSystemGroup = + parserOptionGroup "System Options" $ + SystemGroup + <$> switch (long "poll" <> help "Whether to poll") + <*> parseNested2 + <*> option auto (long "timeout" <> metavar "INT" <> help "Whether to time out") + + parseNested2 = + parserOptionGroup "Nested2" $ + Nested2 + <$> option auto (long "double-nested" <> metavar "STR" <> help "Some nested option") + <*> parseNested3 + + parseNested3 = + parserOptionGroup "Nested3" $ + Nested3 <$> option auto (long "triple-nested" <> metavar "STR" <> help "Another option") + + parseGroup2 :: Parser (Int, Int) + parseGroup2 = parserOptionGroup "Group 2" $ + (,) + <$> parserOptionGroup "G 2.1" (option auto (long "one" <> help "Option 1")) + <*> parserOptionGroup "G 2.2" (option auto (long "two" <> help "Option 2")) + + parseVerbosity = + option auto (long "verbosity" <> short 'v' <> help "Console verbosity") + + parseCmd = + argument str (metavar "Command") + +opts :: ParserInfo Sample +opts = + info + (sample <**> helper) + ( progDesc "Nested parser groups" + <> header "parser_group.nested_desc_opt_groups_style - a test for optparse-applicative" + ) + +main :: IO () +main = do + r <- customExecParser myPrefs opts + print r + +myPrefs :: ParserPrefs +myPrefs = prefs (helpShowGlobals <> briefDescOpt (BriefDescOptGroups $ Just styleFn)) + +-- Custom style fn, skip some groups. +styleFn :: String -> Maybe Doc +styleFn "First group" = Nothing +styleFn "Second group" = Nothing +styleFn "Group 2" = Nothing +styleFn g = Just . Doc.angles . Doc.pretty . fmap Ch.toUpper . dropColon $ g + +dropColon :: String -> String +dropColon [] = [] +dropColon [':'] = [] +dropColon (x : xs) = x : dropColon xs diff --git a/tests/parser_group_nested_desc_opt_groups.err.txt b/tests/parser_group_nested_desc_opt_groups.err.txt new file mode 100644 index 00000000..f2aca140 --- /dev/null +++ b/tests/parser_group_nested_desc_opt_groups.err.txt @@ -0,0 +1,36 @@ +parser_group.nested_desc_opt_groups - a test for optparse-applicative + +Usage: parser_group_nested_desc_opt_groups + [Available options] [First group] [Second group] [Logging] + [System Options] [Nested2] [Nested3] [Group 2] [G 2.1] [G 2.2] Command + + Nested parser groups + +Available options: + --hello TARGET Target for the greeting + -q,--quiet Whether to be quiet + -v,--verbosity ARG Console verbosity + -h,--help Show this help text + +First group +- Second group + - Logging + --file-log-path PATH Log file path + --file-log-verbosity INT File log verbosity + + - System Options + --poll Whether to poll + --timeout INT Whether to time out + + - Nested2 + --double-nested STR Some nested option + + - Nested3 + --triple-nested STR Another option + +Group 2 +- G 2.1 + --one ARG Option 1 + +- G 2.2 + --two ARG Option 2 diff --git a/tests/parser_group_nested_desc_opt_groups_style.err.txt b/tests/parser_group_nested_desc_opt_groups_style.err.txt new file mode 100644 index 00000000..409c1f80 --- /dev/null +++ b/tests/parser_group_nested_desc_opt_groups_style.err.txt @@ -0,0 +1,36 @@ +parser_group.nested_desc_opt_groups_style - a test for optparse-applicative + +Usage: parser_group_nested_desc_opt_groups_style + + Command + + Nested parser groups + +Available options: + --hello TARGET Target for the greeting + -q,--quiet Whether to be quiet + -v,--verbosity ARG Console verbosity + -h,--help Show this help text + +First group +- Second group + - Logging + --file-log-path PATH Log file path + --file-log-verbosity INT File log verbosity + + - System Options + --poll Whether to poll + --timeout INT Whether to time out + + - Nested2 + --double-nested STR Some nested option + + - Nested3 + --triple-nested STR Another option + +Group 2 +- G 2.1 + --one ARG Option 1 + +- G 2.2 + --two ARG Option 2 diff --git a/tests/test.hs b/tests/test.hs index 55adee55..1c71d079 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -19,9 +19,12 @@ import qualified Examples.ParserGroup.CommandGroups as ParserGroup.CommandGroups import qualified Examples.ParserGroup.DuplicateCommandGroups as ParserGroup.DuplicateCommandGroups import qualified Examples.ParserGroup.Duplicates as ParserGroup.Duplicates import qualified Examples.ParserGroup.Nested as ParserGroup.Nested +import qualified Examples.ParserGroup.NestedDescOptGroups as ParserGroup.NestedDescOptGroups +import qualified Examples.ParserGroup.NestedDescOptGroupsStyle as ParserGroup.NestedDescOptGroupsStyle import Control.Applicative import Control.Monad +import qualified Data.Char as Ch import Data.Function (on) import Data.List hiding (group) import Data.List.NonEmpty (NonEmpty ((:|))) @@ -85,7 +88,10 @@ checkHelpTextWith ecode pprefs name p args = ioProperty $ do in (expected === msg ++ "\n") .&&. (ecode === code) checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Property -checkHelpText = checkHelpTextWith ExitSuccess defaultPrefs +checkHelpText = checkHelpTextPrefs defaultPrefs + +checkHelpTextPrefs :: Show a => ParserPrefs -> String -> ParserInfo a -> [String] -> Property +checkHelpTextPrefs prefs = checkHelpTextWith ExitSuccess prefs prop_hello :: Property prop_hello = once $ @@ -1130,6 +1136,22 @@ prop_parser_group_nested :: Property prop_parser_group_nested = once $ checkHelpText "parser_group_nested" ParserGroup.Nested.opts ["--help"] +prop_parser_group_nested_desc_opt_groups :: Property +prop_parser_group_nested_desc_opt_groups = once $ + checkHelpTextPrefs + ParserGroup.NestedDescOptGroups.myPrefs + "parser_group_nested_desc_opt_groups" + ParserGroup.NestedDescOptGroups.opts + ["--help"] + +prop_parser_group_nested_desc_opt_groups_style :: Property +prop_parser_group_nested_desc_opt_groups_style = once $ + checkHelpTextPrefs + ParserGroup.NestedDescOptGroupsStyle.myPrefs + "parser_group_nested_desc_opt_groups_style" + ParserGroup.NestedDescOptGroupsStyle.opts + ["--help"] + prop_issue_450_subcommand_show_help_on_empty_inline :: Property prop_issue_450_subcommand_show_help_on_empty_inline = once $ let