Fix hover format

Author: July541

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -32,9 +32,9 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat.Util      as Util
+import           Development.IDE.GHC.Util             (printOutputable)
 import           Development.IDE.Spans.Common
 import           Development.IDE.Types.Options
-import           Development.IDE.GHC.Util             (printOutputable)
 
 import           Control.Applicative
 import           Control.Monad.Extra
@@ -231,11 +231,14 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
         prettyNames = map prettyName names
         prettyName (Right n, dets) = T.unlines $
           wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
-          : definedAt n
-          ++ maybeToList (prettyPackageName n)
+          : maybeToList (pretty (definedAt n) (prettyPackageName n))
           ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
                        ]
           where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n
+                pretty Nothing Nothing = Nothing
+                pretty (Just define) Nothing = Just $ define <> "\n"
+                pretty Nothing (Just pkgName) = Just $ pkgName <> "\n"
+                pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n"
         prettyName (Left m,_) = printOutputable m
 
         prettyPackageName n = do
@@ -255,8 +258,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
           -- do not show "at <no location info>" and similar messages
           -- see the code of 'pprNameDefnLoc' for more information
           case nameSrcLoc name of
-            UnhelpfulLoc {} | isInternalName name || isSystemName name -> []
-            _ -> ["*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"]
+            UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing
+            _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"
 
 typeLocationsAtPoint
   :: forall m

ghcide/test/exe/Main.hs

@@ -4348,6 +4348,7 @@ findDefinitionAndHoverTests = let
   imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
   reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14]
   thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]
+  doc36 = Position 36 20; multiDoc = [ExpectHoverText ["\n\n[Documentation](file:///"]]
   in
   mkFindTests
   --      def    hover  look       expect
@@ -4410,6 +4411,7 @@ findDefinitionAndHoverTests = let
         test  no     broken   thLocL57   thLoc         "TH Splice Hover"
        | otherwise ->
         test  no     yes       thLocL57   thLoc         "TH Splice Hover"
+  , test  yes    yes    doc36      multiDoc      "two newlines before document"
   ]
   where yes, broken :: (TestTree -> Maybe TestTree)
         yes    = Just -- test should run and pass