Enhancements to hover

.hlint.yaml

@@ -85,6 +85,7 @@
     - Development.IDE.LSP.CodeAction
     - Development.IDE.Spans.Calculate
     - Development.IDE.Spans.Documentation
+    - Development.IDE.Spans.Common
     - Main
 
 - flags:

ghcide.cabal

@@ -134,6 +134,7 @@ library
         Development.IDE.LSP.Outline
         Development.IDE.Spans.AtPoint
         Development.IDE.Spans.Calculate
+        Development.IDE.Spans.Common
         Development.IDE.Spans.Documentation
         Development.IDE.Spans.Type
     ghc-options: -Wall -Wno-name-shadowing

src/Development/IDE/Core/Completions.hs

@@ -25,8 +25,6 @@ import Type
 import Var
 import Packages
 import DynFlags
-import ConLike
-import DataCon
 
 import Language.Haskell.LSP.Types
 import Language.Haskell.LSP.Types.Capabilities
@@ -35,25 +33,9 @@ import Development.IDE.Core.CompletionsTypes
 import Development.IDE.Spans.Documentation
 import Development.IDE.GHC.Error
 import Development.IDE.Types.Options
-
-#ifndef GHC_LIB
+import Development.IDE.Spans.Common
 import Development.IDE.GHC.Util
 
-
-safeTyThingType :: TyThing -> Maybe Type
-safeTyThingType thing
-  | Just i <- safeTyThingId thing = Just (varType i)
-safeTyThingType (ATyCon tycon)    = Just (tyConKind tycon)
-safeTyThingType _                 = Nothing
-#endif
-
--- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
-
-safeTyThingId :: TyThing -> Maybe Id
-safeTyThingId (AnId i)                    = Just i
-safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc
-safeTyThingId _                           = Nothing
-
 -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
 
 -- | A context of a declaration in the program
@@ -158,7 +140,7 @@ mkCompl IdeOptions{..} CI{origName,importedFrom,thingType,label,isInfix,docs} =
         typeText
           | Just t <- thingType = Just . stripForall $ T.pack (showGhc t)
           | otherwise = Nothing
-        docs' = ("*Defined in '" <> importedFrom <> "'*\n") : docs
+        docs' = ("*Defined in '" <> importedFrom <> "'*\n") : spanDocToMarkdown docs
         colon = if optNewColonConvention then ": " else ":: "
 
 stripForall :: T.Text -> T.Text
@@ -275,12 +257,12 @@ cacheDataProducer packageState dflags tm tcs = do
         let typ = Just $ varType var
             name = Var.varName var
             label = T.pack $ showGhc name
-        docs <- getDocumentationTryGhc packageState (tm:tcs) name
+        docs <- runGhcEnv packageState $ getDocumentationTryGhc (tm:tcs) name
         return $ CI name (showModName curMod) typ label Nothing docs
 
       toCompItem :: ModuleName -> Name -> IO CompItem
       toCompItem mn n = do
-        docs <- getDocumentationTryGhc packageState (tm:tcs) n
+        docs <- runGhcEnv packageState $ getDocumentationTryGhc (tm:tcs) n
 -- lookupName uses runInteractiveHsc, i.e., GHCi stuff which does not work with GHCi
 -- and leads to fun errors like "Cannot continue after interface file error".
 #ifdef GHC_LIB

src/Development/IDE/Core/CompletionsTypes.hs

@@ -5,15 +5,11 @@ module Development.IDE.Core.CompletionsTypes (
 import           Control.DeepSeq
 import qualified Data.Map  as Map
 import qualified Data.Text as T
-
 import           GHC
-import           Outputable
-import           DynFlags
 
--- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
+import Development.IDE.Spans.Common
 
-showGhc :: Outputable a => a -> String
-showGhc = showPpr unsafeGlobalDynFlags
+-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
 
 data Backtick = Surrounded | LeftSide deriving Show
 data CompItem = CI
@@ -23,7 +19,7 @@ data CompItem = CI
   , label        :: T.Text         -- ^ Label to display to the user.
   , isInfix      :: Maybe Backtick -- ^ Did the completion happen
                                    -- in the context of an infix notation.
-  , docs         :: [T.Text]       -- ^ Available documentation.
+  , docs         :: SpanDoc        -- ^ Available documentation.
   }
 instance Show CompItem where
   show CI { .. } = "CompItem { origName = \"" ++ showGhc origName ++ "\""

src/Development/IDE/Core/Rules.hs

@@ -104,9 +104,7 @@ getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.T
 getAtPoint file pos = fmap join $ runMaybeT $ do
   opts <- lift getIdeOptions
   spans <- useE GetSpanInfo file
-  files <- transitiveModuleDeps <$> useE GetDependencies file
-  tms   <- usesE TypeCheck (file : files)
-  return $ AtPoint.atPoint opts (map tmrModule tms) spans pos
+  return $ AtPoint.atPoint opts spans pos
 
 -- | Goto Definition.
 getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
@@ -262,9 +260,11 @@ getSpanInfoRule :: Rules ()
 getSpanInfoRule =
     define $ \GetSpanInfo file -> do
         tc <- use_ TypeCheck file
+        deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file
+        tms <- mapMaybe (fmap fst) <$> usesWithStale TypeCheck (transitiveModuleDeps deps)
         (fileImports, _) <- use_ GetLocatedImports file
         packageState <- hscEnv <$> use_ GhcSession file
-        x <- liftIO $ getSrcSpanInfos packageState fileImports tc
+        x <- liftIO $ getSrcSpanInfos packageState fileImports tc tms
         return ([], Just x)
 
 -- Typechecks a module.

src/Development/IDE/Spans/AtPoint.hs

@@ -8,7 +8,6 @@ module Development.IDE.Spans.AtPoint (
   , gotoDefinition
   ) where
 
-import           Development.IDE.Spans.Documentation
 import           Development.IDE.GHC.Error
 import Development.IDE.GHC.Orphans()
 import Development.IDE.Types.Location
@@ -18,7 +17,8 @@ import Development.Shake
 import Development.IDE.GHC.Util
 import Development.IDE.GHC.Compat
 import Development.IDE.Types.Options
-import           Development.IDE.Spans.Type as SpanInfo
+import Development.IDE.Spans.Type as SpanInfo
+import Development.IDE.Spans.Common (spanDocToMarkdown)
 
 -- GHC API imports
 import Avail
@@ -50,40 +50,42 @@ gotoDefinition getHieFile ideOpts pkgState srcSpans pos =
 -- | Synopsis for the name at a given position.
 atPoint
   :: IdeOptions
-  -> [TypecheckedModule]
   -> [SpanInfo]
   -> Position
   -> Maybe (Maybe Range, [T.Text])
-atPoint IdeOptions{..} tcs srcSpans pos = do
+atPoint IdeOptions{..} srcSpans pos = do
     firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint pos srcSpans
     return (Just (range firstSpan), hoverInfo firstSpan)
   where
     -- Hover info for types, classes, type variables
-    hoverInfo SpanInfo{spaninfoType = Nothing , ..} =
-       documentation <> (wrapLanguageSyntax <$> name <> kind) <> location
+    hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs ,  ..} =
+       (wrapLanguageSyntax <$> name) <> location <> spanDocToMarkdown docs
      where
-       documentation = findDocumentation mbName
        name     = [maybe shouldNotHappen showName  mbName]
        location = [maybe shouldNotHappen definedAt mbName]
-       kind     = [] -- TODO
        shouldNotHappen = "ghcide: did not expect a type level component without a name"
        mbName = getNameM spaninfoSource
 
     -- Hover info for values/data
-    hoverInfo SpanInfo{spaninfoType = (Just typ), ..} =
-       documentation <> (wrapLanguageSyntax <$> nameOrSource <> typeAnnotation) <> location
+    hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} =
+       (wrapLanguageSyntax <$> nameOrSource) <> location <> spanDocToMarkdown docs
      where
        mbName = getNameM spaninfoSource
-       documentation  = findDocumentation mbName
-       typeAnnotation = [colon <> showName typ]
-       nameOrSource   = [maybe literalSource qualifyNameIfPossible mbName]
-       literalSource = "" -- TODO: literals: display (length-limited) source
+       typeAnnotation = colon <> showName typ
+       expr = case spaninfoSource of
+                Named n -> qualifyNameIfPossible n
+                Lit   l -> crop $ T.pack l
+                _       -> ""
+       nameOrSource   = [expr <> "\n" <> typeAnnotation]
        qualifyNameIfPossible name' = modulePrefix <> showName name'
          where modulePrefix = maybe "" (<> ".") (getModuleNameAsText name')
        location = [maybe "" definedAt mbName]
 
-    findDocumentation = maybe [] (getDocumentation tcs)
-    definedAt name = "**Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "**\n"
+    definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*\n"
+
+    crop txt
+      | T.length txt > 50 = T.take 46 txt <> " ..."
+      | otherwise         = txt
 
     range SpanInfo{..} = Range
       (Position spaninfoStartLine spaninfoStartCol)
@@ -112,6 +114,7 @@ locationsAtPoint getHieFile IdeOptions{..} pkgState pos =
   where getSpan :: SpanSource -> m (Maybe SrcSpan)
         getSpan NoSource = pure Nothing
         getSpan (SpanS sp) = pure $ Just sp
+        getSpan (Lit _) = pure Nothing
         getSpan (Named name) = case nameSrcSpan name of
             sp@(RealSrcSpan _) -> pure $ Just sp
             sp@(UnhelpfulSpan _) -> runMaybeT $ do