diff --git a/src/Options/Applicative/Common.hs b/src/Options/Applicative/Common.hs index 91e03cd..8507c59 100644 --- a/src/Options/Applicative/Common.hs +++ b/src/Options/Applicative/Common.hs @@ -266,8 +266,8 @@ mapParser f = flatten . treeMapParser f -- | Like 'mapParser', but collect the results in a tree structure. treeMapParser :: (forall x. ArgumentReachability -> Option x -> b) - -> Parser a - -> OptTree b + -> Parser a + -> OptTree b treeMapParser g = simplify . go False g where has_default :: Parser a -> Bool diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index eb97416..b63dcbb 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -116,10 +116,10 @@ briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc briefDesc' showOptional pprefs = wrapOver NoDefault MaybeRequired . foldTree pprefs style - . mfilterOptional - . treeMapParser (\a -> (\(_, x, y) -> (x, y)) . optDesc pprefs style a) + . mFilterOptional + . treeMapParser optDesc' where - mfilterOptional + mFilterOptional | showOptional = id | otherwise = @@ -129,6 +129,12 @@ briefDesc' showOptional pprefs = descHidden = False, descGlobal = False } + optDesc' reach opt = + let + (_, a, b) = + optDesc pprefs style reach opt + in + (a, b) -- | Wrap a doc in parentheses or brackets if required. wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc @@ -331,21 +337,18 @@ optionsDesc global pprefs p = descGlobal = global } + -- -- Prints all parent titles that have not already been printed -- (i.e. in printedGroups). mkParentDocs :: [String] -> [(Int, String)] -> Doc - mkParentDocs printedGroups = foldl' g (pretty "") . reverse + mkParentDocs printedGroups = + foldr g mempty where - g :: Doc -> (Int, String) -> Doc - g acc (i, s) = - if s `List.elem` printedGroups - then acc - else - if i == 0 - -- Top-level parent has no special formatting - then pretty s .$. acc - -- Nested parent is hyphenated and possibly indented. - else lvlIndentNSub1 i $ hyphenate s .$. acc + g :: (Int, String) -> Doc -> Doc + g (i, s) acc + | s `List.elem` printedGroups = acc + | i == 0 = pretty s .$. acc + | otherwise = lvlIndentNSub1 i $ hyphenate s .$. acc hyphenate s = pretty ("- " <> s) @@ -478,12 +481,6 @@ groupFstAll = zipWithIndex :: [(a, b)] -> [(Int, (a, b))] zipWithIndex = zip [1 ..] +-- | From base-4.19.0.0. unsnoc :: [a] -> Maybe ([a], a) -unsnoc [] = Nothing -unsnoc [x] = Just ([], x) -unsnoc (x:xs) = Just (x:a, b) - where - (a, b) = case unsnoc xs of - Just y -> y - Nothing -> - error "Options.Applicative.Help.Core.unsnoc: impossible" +unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing