Add number of columns as a preference.

Options/Applicative/Builder.hs

@@ -83,6 +83,7 @@ module Options.Applicative.Builder (
   disambiguate,
   showHelpOnError,
   noBacktrack,
+  columns,
   prefs,
 
   -- * Types
@@ -357,14 +358,18 @@ showHelpOnError = PrefsMod $ \p -> p { prefShowHelpOnError = True }
 noBacktrack :: PrefsMod
 noBacktrack = PrefsMod $ \p -> p { prefBacktrack = False }
 
+columns :: Int -> PrefsMod
+columns cols = PrefsMod $ \p -> p { prefColumns = cols }
+
 prefs :: PrefsMod -> ParserPrefs
 prefs m = applyPrefsMod m base
   where
     base = ParserPrefs
       { prefMultiSuffix = ""
       , prefDisambiguate = False
       , prefShowHelpOnError = False
-      , prefBacktrack = True }
+      , prefBacktrack = True
+      , prefColumns = 80 }
 
 -- convenience shortcuts
 

Options/Applicative/Extra.hs

@@ -127,7 +127,9 @@ parserFailure pprefs pinfo msg ctx = ParserFailure
     with_context (Context n i) _ f = f n i
 
     render_help :: ParserHelp -> String
-    render_help = (`displayS` "") . renderPretty 1.0 80 . helpText
+    render_help = (`displayS` "")
+                . renderPretty 1.0 (prefColumns pprefs)
+                . helpText
 
     show_full_help = case msg of
       ShowHelpText -> True

Options/Applicative/Help/Pretty.hs

@@ -3,7 +3,7 @@ module Options.Applicative.Help.Pretty
   , (.$.)
   ) where
 
-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns)
 import qualified Text.PrettyPrint.ANSI.Leijen as PP
 
 (.$.) :: Doc -> Doc -> Doc

Options/Applicative/Types.hs

@@ -54,7 +54,8 @@ instance Error ParseError where
 -- | A full description for a runnable 'Parser' for a program.
 data ParserInfo a = ParserInfo
   { infoParser :: Parser a            -- ^ the option parser for the program
-  , infoFullDesc :: Bool              -- ^ whether the help text should contain full documentation
+  , infoFullDesc :: Bool              -- ^ whether the help text should contain
+                                      -- full documentation
   , infoProgDesc :: Chunk Doc         -- ^ brief parser description
   , infoHeader :: Chunk Doc           -- ^ header of the full parser description
   , infoFooter :: Chunk Doc           -- ^ footer of the full parser description
@@ -67,9 +68,14 @@ instance Functor ParserInfo where
 -- | Global preferences for a top-level 'Parser'.
 data ParserPrefs = ParserPrefs
   { prefMultiSuffix :: String    -- ^ metavar suffix for multiple options
-  , prefDisambiguate :: Bool     -- ^ automatically disambiguate abbreviations (default: False)
-  , prefShowHelpOnError :: Bool  -- ^ always show help text on parse errors (default: False)
-  , prefBacktrack :: Bool        -- ^ backtrack to parent parser when a subcommand fails (default: True)
+  , prefDisambiguate :: Bool     -- ^ automatically disambiguate abbreviations
+                                 -- (default: False)
+  , prefShowHelpOnError :: Bool  -- ^ always show help text on parse errors
+                                 -- (default: False)
+  , prefBacktrack :: Bool        -- ^ backtrack to parent parser when a
+                                 -- subcommand fails (default: True)
+  , prefColumns :: Int           -- ^ number of columns in the terminal, used to
+                                 -- format the help page (default: 80)
   }
 
 data OptName = OptShort !Char

tests/Tests.hs

@@ -35,15 +35,19 @@ assertHasLine l s
   | l `elem` lines s = return ()
   | otherwise = assertFailure $ "expected line:\n\t" ++ l ++ "\nnot found"
 
-checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Assertion
-checkHelpText name p args = do
-  let result = run p args
+checkHelpTextWith :: Show a => ParserPrefs -> String
+                  -> ParserInfo a -> [String] -> Assertion
+checkHelpTextWith pprefs name p args = do
+  let result = execParserPure pprefs p args
   assertLeft result $ \(ParserFailure err code) -> do
     expected <- readFile $ "tests/" ++ name ++ ".err.txt"
     msg <- err name
     expected @=? msg ++ "\n"
     ExitFailure 1 @=? code
 
+checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Assertion
+checkHelpText = checkHelpTextWith (prefs idm)
+
 case_hello :: Assertion
 case_hello = checkHelpText "hello" Hello.opts ["--help"]
 
@@ -330,7 +334,7 @@ case_long_help = do
             [ "This is a very long program description. "
             , "This text should be automatically wrapped "
             , "to fit the size of the terminal" ]) )
-  checkHelpText "formatting" i ["--help"]
+  checkHelpTextWith (prefs (columns 50)) "formatting" i ["--help"]
 
 main :: IO ()
 main = $(defaultMainGenerator)

tests/formatting.err.txt

@@ -1,9 +1,13 @@
 Usage: formatting [-t|--test ARG]
-  This is a very long program description. This text should be automatically
-  wrapped to fit the size of the terminal
+  This is a very long program description. This
+  text should be automatically wrapped to fit the
+  size of the terminal
 
 Available options:
-  -t,--test ARG            This is an options with a very very long description.
-                           Hopefully, this will be nicely formatted by the help
+  -t,--test ARG            This is an options with
+                           a very very long
+                           description. Hopefully,
+                           this will be nicely
+                           formatted by the help
                            text generator.
   -h,--help                Show this help text