Fix haskell#7714: use nroff -man | less as backend for cabal man

Directly piping into `man -l -` does not work as BSD-`man` does not
understand option `-l`.  More standardized are the building blocks
`nroff` and `less`.

`cabal man` now should behave as pipeline
```
cabal man --raw | nroff -man /dev/stdin | less
```

Also fixed output of `cabal man --raw` so that it does not produce
warnings.

- `.R` removed.  Was warning:
  ```
  `R' is a string (producing the registered sign), not a macro.
  ```

- No quoted 'new-FOO' should appear at beginning of line.  Was
  warning:
  ```
  warning: macro `new-FOO'' not defined (probably missing space after `ne')
  ```

Added to `cabal-testsuite/PackageTests/Man/cabal.test.hs` a check that
the `stderr` output of `nroff -man /dev/stdin` is empty (no warnings).

Remaining problem:

Unfortunately, after quitting `less` with `q` the following error is
displayed:
```
fd:NNN: commitBuffer: resource vanished (Broken pipe)
```
Not sure how to fix this (my attempts failed).

Author: andreasabel

cabal-install/main/Main.hs

@@ -972,7 +972,7 @@ manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action
 manpageAction commands flags extraArgs _ = do
   let verbosity = fromFlag (manpageVerbosity flags)
   unless (null extraArgs) $
-    die' verbosity $ "'manpage' doesn't take any extra arguments: " ++ unwords extraArgs
+    die' verbosity $ "'man' doesn't take any extra arguments: " ++ unwords extraArgs
   pname <- getProgName
   let cabalCmd = if takeExtension pname == ".exe"
                  then dropExtension pname

cabal-install/src/Distribution/Client/Manpage.hs

@@ -22,12 +22,17 @@ module Distribution.Client.Manpage
 
 import Distribution.Client.Compat.Prelude
 import Prelude ()
+import qualified Data.List.NonEmpty as List1
 
+import Distribution.Client.Init.Utils   (trim)
+  -- TODO #7744: move 'trim' to a more canonical place
 import Distribution.Client.ManpageFlags
 import Distribution.Client.Setup        (globalCommand)
-import Distribution.Compat.Process      (createProcess)
 import Distribution.Simple.Command
 import Distribution.Simple.Flag         (fromFlagOrDefault)
+import Distribution.Simple.Utils
+  ( IOData(..), IODataMode(..), createProcessWithEnv, rawSystemStdInOut )
+import qualified Distribution.Verbosity as Verbosity
 import System.IO                        (hClose, hPutStr)
 
 import qualified System.Process as Process
@@ -50,23 +55,43 @@ manpageCmd pname commands flags
     = putStrLn contents
     | otherwise
     = do
-        let cmd  = "man"
-            args = ["-l", "-"]
-
-        (mb_in, _, _, ph) <- createProcess (Process.proc cmd args)
-            { Process.std_in  = Process.CreatePipe
-            , Process.std_out = Process.Inherit
-            , Process.std_err = Process.Inherit
-            }
-
-        -- put contents
-        for_ mb_in $ \hin -> do
-            hPutStr hin contents
-            hClose hin
-
-        -- wait for process to exit, propagate exit code
-        ec <- Process.waitForProcess ph
-        exitWith ec
+        -- 2021-10-08, issue #7714
+        -- @cabal man --raw | man -l -@ does not work on macOS/BSD,
+        -- because BSD-man does not support option @-l@, rather would
+        -- accept directly a file argument, e.g. @man /dev/stdin@.
+        -- The following works both on macOS and Linux
+        -- (but not on Windows out-of-the-box):
+        --
+        --   cabal man --raw | nroff -man /dev/stdin | less
+        --
+        -- So let us simulate this!
+
+        -- Feed contents into @nroff -man /dev/stdin@
+        (formatted, _errors, ec1) <- rawSystemStdInOut
+          Verbosity.normal
+          "nroff"
+          [ "-man", "/dev/stdin" ]
+          Nothing  -- Inherit working directory
+          Nothing  -- Inherit environment
+          (Just $ IODataText contents)
+          IODataModeText
+
+        unless (ec1 == ExitSuccess) $ exitWith ec1
+
+        -- Pipe output of @nroff@ into @less@
+        (Just inLess, _, _, procLess) <- createProcessWithEnv
+          Verbosity.normal
+          "less"
+          []
+          Nothing  -- Inherit working directory
+          Nothing  -- Inherit environment
+          Process.CreatePipe  -- in
+          Process.Inherit     -- out
+          Process.Inherit     -- err
+
+        hPutStr inLess formatted
+        hClose  inLess
+        exitWith =<< Process.waitForProcess procLess
   where
     contents :: String
     contents = manpage pname commands
@@ -117,7 +142,7 @@ manpage pname commands = unlines $
 commandSynopsisLines :: String -> CommandSpec action -> [String]
 commandSynopsisLines pname (CommandSpec ui _ NormalCommand) =
   [ ".B " ++ pname ++ " " ++ (commandName ui)
-  , ".R - " ++ commandSynopsis ui
+  , "- " ++ commandSynopsis ui
   , ".br"
   ]
 commandSynopsisLines _ (CommandSpec _ _ HiddenCommand) = []
@@ -129,8 +154,8 @@ commandDetailsLines pname (CommandSpec ui _ NormalCommand) =
   , commandUsage ui pname
   , ""
   ] ++
-  optional commandDescription ++
-  optional commandNotes ++
+  optional removeLineBreaks commandDescription ++
+  optional id commandNotes ++
   [ "Flags:"
   , ".RS"
   ] ++
@@ -139,10 +164,26 @@ commandDetailsLines pname (CommandSpec ui _ NormalCommand) =
   , ""
   ]
   where
-    optional field =
+    optional f field =
       case field ui of
-        Just text -> [text pname, ""]
+        Just text -> [ f $ text pname, "" ]
         Nothing   -> []
+    -- 2021-10-12, https://github.com/haskell/cabal/issues/7714#issuecomment-940842905
+    -- Line breaks just before e.g. 'new-build' cause weird @nroff@ warnings.
+    -- Thus:
+    -- Remove line breaks but preserve paragraph breaks.
+    -- We group lines by empty/non-empty and then 'unwords'
+    -- blocks consisting of non-empty lines.
+    removeLineBreaks
+      = unlines
+      . concatMap unwordsNonEmpty
+      . List1.groupWith null
+      . map trim
+      . lines
+    unwordsNonEmpty :: List1.NonEmpty String -> [String]
+    unwordsNonEmpty ls1 = if null (List1.head ls1) then ls else [unwords ls]
+      where ls = List1.toList ls1
+
 commandDetailsLines _ (CommandSpec _ _ HiddenCommand) = []
 
 optionsLines :: CommandUI flags -> [String]

cabal-testsuite/PackageTests/Manpage/cabal.test.hs

@@ -1,5 +1,21 @@
+import System.Process
 import Test.Cabal.Prelude
+
+
 main = cabalTest $ do
     r <- cabal' "man" ["--raw"]
     assertOutputContains ".B cabal install" r
     assertOutputDoesNotContain ".B cabal manpage" r
+
+    -- Check that output of `cabal man --raw` can be passed through `nroff -man`
+    -- without producing any warnings (which are printed to stderr).
+    --
+    -- NB: runM is not suitable as it mixes stdout and stderr
+    -- r2 <- runM "nroff" ["-man", "/dev/stdin"] $ Just $ resultOutput r
+    (ec, _output, errors) <- liftIO $
+      readProcessWithExitCode "nroff" ["-man", "/dev/stdin"] $ resultOutput r
+    unless (null errors) $
+      assertFailure $ unlines
+        [ "Error: unexpected warnings produced by `nroff -man`:"
+        , errors
+        ]