Elide extraneous messages for :doc command (#15784)

Do not print `<has no documentation>` alongside a valid doc.
Additionally, if two matching symbols lack documentation then the
message will only be printed once. Hence, `<has no documentation>` will
be printed at most once and only if all matching symbols are lacking
docs.

4 files changed, 26 insertions, 5 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d44eb79bd1..81b0a84fca 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1791,22 +1791,32 @@ docCmd "" =
 docCmd s  = do
   -- TODO: Maybe also get module headers for module names
   names <- GHC.parseName s
-  e_docss <- mapM GHC.getDocs names
-  sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss
+  e_docss <- sequence <$> mapM GHC.getDocs names
+  sdocs <- either handleGetDocsFailure (pure . pprDocs) e_docss
   let sdocs' = vcat (intersperse (text "") sdocs)
   unqual <- GHC.getPrintUnqual
   dflags <- getDynFlags
   (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs'
 
+pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc]
+pprDocs docs
+  | null nonEmptyDocs = pprDoc <$> take 1 docs
+  -- elide <has no documentation> if there's at least one non-empty doc (#15784)
+  | otherwise = pprDoc <$> nonEmptyDocs
+  where
+    empty (mb_decl_docs, arg_docs)
+      = isNothing mb_decl_docs && null arg_docs
+    nonEmptyDocs = filter (not . empty) docs
+
 -- TODO: also print arg docs.
-pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
-pprDocs (mb_decl_docs, _arg_docs) =
+pprDoc :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
+pprDoc (mb_decl_docs, _arg_docs) =
   maybe
     (text "<has no documentation>")
     (text . unpackHDS)
     mb_decl_docs
 
-handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc
+handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m [SDoc]
 handleGetDocsFailure no_docs = do
   dflags <- getDynFlags
   let msg = showPpr dflags no_docs
diff --git a/testsuite/tests/ghci/scripts/ghci065.hs b/testsuite/tests/ghci/scripts/ghci065.hs
index 7035b4815d..8ff89cd12e 100644
--- a/testsuite/tests/ghci/scripts/ghci065.hs
+++ b/testsuite/tests/ghci/scripts/ghci065.hs
@@ -13,6 +13,13 @@ data Data1 = Val1a | Val1b
 data Data2 = Val2a  -- ^ This is the haddock comment of a data value for Val2a
            | Val2b  -- ^ This is the haddock comment of a data value for Val2b
 
+-- | This is the haddock comment of a data declaration for Data3.
+newtype Data3 =
+  Data3 { getData3 :: Int }
+
+newtype Data4 =
+  -- | This is the haddock comment of a data constructor for Data4.
+  Data4 { getData4 :: Int }
 
 -- | This is the haddock comment of a function declaration for func1.
 func1 :: Int -> Int -> Int
diff --git a/testsuite/tests/ghci/scripts/ghci065.script b/testsuite/tests/ghci/scripts/ghci065.script
index ec51b24fe5..7f05945576 100644
--- a/testsuite/tests/ghci/scripts/ghci065.script
+++ b/testsuite/tests/ghci/scripts/ghci065.script
@@ -5,6 +5,8 @@
 :doc Data1
 :doc Val2a
 :doc Val2b
+:doc Data3
+:doc Data4
 
 :doc func1
 :doc func2
diff --git a/testsuite/tests/ghci/scripts/ghci065.stdout b/testsuite/tests/ghci/scripts/ghci065.stdout
index c3d69ca4ef..b14f3f503a 100644
--- a/testsuite/tests/ghci/scripts/ghci065.stdout
+++ b/testsuite/tests/ghci/scripts/ghci065.stdout
@@ -1,6 +1,8 @@
  This is the haddock comment of a data declaration for Data1.
  This is the haddock comment of a data value for Val2a
  This is the haddock comment of a data value for Val2b
+ This is the haddock comment of a data declaration for Data3.
+ This is the haddock comment of a data constructor for Data4.
  This is the haddock comment of a function declaration for func1.
 <has no documentation>
  This is the haddock comment of a function declaration for func3.