mirror of
https://github.com/ilyakooo0/optparse-applicative.git
synced 2024-09-11 10:45:25 +03:00
Merge pull request #354 from pcapriotti/topic/improve-readability
Improve readability of help text
This commit is contained in:
commit
5478fc16cb
@ -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))
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user