diff options
| -rw-r--r-- | ghc/GHCi/UI.hs | 20 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/ghci065.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/ghci065.script | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/ghci065.stdout | 2 |
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. |