[Git][ghc/ghc][master] 2 commits: Elide extraneous messages for :doc command (#15784)

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00
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.

- - - - -
5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00
Add :doc test case for duplicate record fields

Tests that the output of the `:doc` command is correct for duplicate
record fields defined using -XDuplicateRecordFields.

- - - - -


4 changed files:

- ghc/GHCi/UI.hs
- testsuite/tests/ghci/scripts/ghci065.hs
- testsuite/tests/ghci/scripts/ghci065.script
- testsuite/tests/ghci/scripts/ghci065.stdout


Changes:

=====================================
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


=====================================
testsuite/tests/ghci/scripts/ghci065.hs
=====================================
@@ -5,6 +5,7 @@
 -- this test is constructed with simple text (without markup) only.
 --
 
+{-# LANGUAGE DuplicateRecordFields #-}
 module Test where
 
 -- | This is the haddock comment of a data declaration for Data1.
@@ -13,6 +14,25 @@ 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 }
+
+data DupeFields1 =
+  DF1 { dupeField :: Int -- ^ This is the first haddock comment of a duplicate record field.
+      }
+
+data DupeFields2 =
+  DF2 { dupeField :: Int -- ^ This is the second haddock comment of a duplicate record field.
+      }
+
+data DupeFields3 =
+  DF3 { dupeField :: Int -- No haddock
+      }
 
 -- | This is the haddock comment of a function declaration for func1.
 func1 :: Int -> Int -> Int


=====================================
testsuite/tests/ghci/scripts/ghci065.script
=====================================
@@ -5,6 +5,9 @@
 :doc Data1
 :doc Val2a
 :doc Val2b
+:doc Data3
+:doc Data4
+:doc dupeField
 
 :doc func1
 :doc func2


=====================================
testsuite/tests/ghci/scripts/ghci065.stdout
=====================================
@@ -1,6 +1,11 @@
  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 second haddock comment of a duplicate record field.
+
+ This is the first haddock comment of a duplicate record field.
  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.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/381eb66012c2b1b9ef50008df57293fe443c2972...5eba91b629745746397ed36f25fe592d08ec667b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/381eb66012c2b1b9ef50008df57293fe443c2972...5eba91b629745746397ed36f25fe592d08ec667b
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201211/7ffa0e47/attachment-0001.html>