Merge pull request #355 from pcapriotti/topic/improve-readability

Nest union types which flow over multiple lines

src/Options/Applicative/Help/Core.hs

@@ -130,7 +130,7 @@ foldTree (MultNode xs)
   = (foldr ((<</>>) . wrap NoDefault . foldTree) mempty xs, Bare)
 foldTree (AltNode b xs)
   = (\x -> (x, Bare))
-  . fmap groupOrLine
+  . fmap groupOrNestLine
   . wrap b
   . alt_node
   . filter (not . isEmpty . fst)
@@ -140,7 +140,7 @@ foldTree (AltNode b xs)
   alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
   alt_node [n] = n
   alt_node ns = (\y -> (y, Wrapped))
-              . foldr (chunked (\x y -> x </> char '|' </> y) . wrap NoDefault) mempty
+              . foldr (chunked altSep . wrap NoDefault) mempty
               $ ns
 
 -- | Generate a full help text for a parser.

src/Options/Applicative/Help/Pretty.hs

@@ -1,11 +1,12 @@
 module Options.Applicative.Help.Pretty
   ( module Text.PrettyPrint.ANSI.Leijen
   , (.$.)
-  , groupOrLine
+  , groupOrNestLine
+  , altSep
   ) where
 
 import           Control.Applicative
-import           Data.Monoid (mappend)
+import           Data.Semigroup ((<>))
 
 import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns)
 import           Text.PrettyPrint.ANSI.Leijen.Internal (Doc (..), flatten)
@@ -16,7 +17,8 @@ import           Prelude
 (.$.) :: Doc -> Doc -> Doc
 (.$.) = (PP.<$>)
 
--- | Apply the funcion if we're not at the
+
+-- | Apply the function if we're not at the
 --   start of our nesting level.
 ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
 ifNotAtRoot f doc =
@@ -26,10 +28,29 @@ ifNotAtRoot f doc =
         then doc
         else f doc
 
+
 -- | Render flattened text on this line, or start
 --   a new line before rendering any text.
-groupOrLine :: Doc -> Doc
-groupOrLine =
+--
+--   This will also nest subsequent lines in the
+--   group.
+groupOrNestLine :: Doc -> Doc
+groupOrNestLine =
   Union
     <$> flatten
-    <*> ifNotAtRoot (mappend line)
+    <*> ifNotAtRoot (line <>) . nest 2
+
+
+-- | Separate items in an alternative with a pipe.
+--
+--   If the first document and the pipe don't fit
+--   on the line, then mandatorily flow the next entry
+--   onto the following line.
+--
+--   The (<//>) softbreak ensures that if the document
+--   does fit on the line, there is at least a space,
+--   but it's possible for y to still appear on the
+--   next line.
+altSep :: Doc -> Doc -> Doc
+altSep x y =
+  group (x <+> char '|' <> line) <//> y