From f84075aaefef31a873d6180d614e03b8daf48030 Mon Sep 17 00:00:00 2001 From: Huw Campbell Date: Fri, 31 Jul 2020 10:07:32 +1000 Subject: [PATCH 1/3] Fix error where internal options where being drawn with an ellipsis --- src/Options/Applicative/Help/Core.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 7a0bab3b..22321839 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -170,8 +170,11 @@ foldTree prefs s (AltNode b xs) = foldTree prefs s (BindNode x) = let rendered = wrapOver NoDefault NeverRequired (foldTree prefs s x) - withPrefix = - rendered <> stringChunk (prefMultiSuffix prefs) + + -- We always want to display the rendered option + -- if it exists, and only attach the suffix then. + withPrefix = do + rendered >>= (\r -> pure r <> stringChunk (prefMultiSuffix prefs)) in (withPrefix, NeverRequired) -- | Generate a full help text for a parser From c61e66b188614f3991f4d4f5c4763d7d3d5fafbe Mon Sep 17 00:00:00 2001 From: Huw Campbell Date: Fri, 31 Jul 2020 10:09:30 +1000 Subject: [PATCH 2/3] Fix inverted binding name --- src/Options/Applicative/Help/Core.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 22321839..6bc57fd3 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -173,9 +173,9 @@ foldTree prefs s (BindNode x) = -- We always want to display the rendered option -- if it exists, and only attach the suffix then. - withPrefix = do + withSuffix = do rendered >>= (\r -> pure r <> stringChunk (prefMultiSuffix prefs)) - in (withPrefix, NeverRequired) + in (withSuffix, NeverRequired) -- | Generate a full help text for a parser fullDesc :: ParserPrefs -> Parser a -> Chunk Doc From 997bc2b773b8f975f99782cf3035b2d53abb4db7 Mon Sep 17 00:00:00 2001 From: Huw Campbell Date: Fri, 31 Jul 2020 10:18:16 +1000 Subject: [PATCH 3/3] Add regression test for #402 --- src/Options/Applicative/Help/Core.hs | 2 +- tests/test.hs | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 6bc57fd3..eb5bb87e 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -173,7 +173,7 @@ foldTree prefs s (BindNode x) = -- We always want to display the rendered option -- if it exists, and only attach the suffix then. - withSuffix = do + withSuffix = rendered >>= (\r -> pure r <> stringChunk (prefMultiSuffix prefs)) in (withSuffix, NeverRequired) diff --git a/tests/test.hs b/tests/test.hs index 6844a941..a66d37cc 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -855,6 +855,13 @@ prop_grouped_many_dual_flag_ellipsis = once $ r = show . extractChunk $ H.briefDesc p (x *> many x) in r === "(-a|-b) [-a|-b]..." +prop_issue_402 :: Property +prop_issue_402 = once $ + let x = some (flag' () (short 'a')) <|> some (flag' () (short 'b' <> internal)) + p = prefs (multiSuffix "...") + r = show . extractChunk $ H.briefDesc p x + in r === "(-a)..." + prop_nice_some1 :: Property prop_nice_some1 = once $ let x = Options.Applicative.NonEmpty.some1 (flag' () (short 'a'))