diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index ad894cb..5778a74 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -112,7 +112,7 @@ briefDesc' showOptional pprefs , descHidden = False } -- | Wrap a doc in parentheses or brackets if required. -wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc +wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc wrap altnode (chunk, wrapping) | altnode == MarkDefault = fmap brackets chunk @@ -130,11 +130,13 @@ foldTree (MultNode xs) = (foldr ((<>) . wrap NoDefault . foldTree) mempty xs, Bare) foldTree (AltNode b xs) = (\x -> (x, Bare)) + . fmap groupOrLine . wrap b . alt_node . filter (not . isEmpty . fst) . map foldTree $ xs where + alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping) alt_node [n] = n alt_node ns = (\y -> (y, Wrapped)) diff --git a/src/Options/Applicative/Help/Pretty.hs b/src/Options/Applicative/Help/Pretty.hs index ef876b6..c983648 100644 --- a/src/Options/Applicative/Help/Pretty.hs +++ b/src/Options/Applicative/Help/Pretty.hs @@ -1,10 +1,35 @@ module Options.Applicative.Help.Pretty ( module Text.PrettyPrint.ANSI.Leijen , (.$.) + , groupOrLine ) where -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns) +import Control.Applicative +import Data.Monoid (mappend) + +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns) +import Text.PrettyPrint.ANSI.Leijen.Internal (Doc (..), flatten) import qualified Text.PrettyPrint.ANSI.Leijen as PP +import Prelude + (.$.) :: Doc -> Doc -> Doc (.$.) = (PP.<$>) + +-- | Apply the funcion if we're not at the +-- start of our nesting level. +ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc +ifNotAtRoot f doc = + Nesting $ \i -> + Column $ \j -> + if i == j + then doc + else f doc + +-- | Render flattened text on this line, or start +-- a new line before rendering any text. +groupOrLine :: Doc -> Doc +groupOrLine = + Union + <$> flatten + <*> ifNotAtRoot (mappend line)