Skip to content

Commit 6d0b6ea

Browse files
serrascocreature
authored andcommitted
Enhancements to hover (#317)
* Show kinds in hover * Documentation on hover * Enable kind tests * Fix tests * Print literals * Show (some) overloaded literals * Fix for 8.4 * Fix tests * Do not consider literals for definitions * Suggestions by @cocreature * No warning for 8.4 * More fixes for 8.4 * Make it work with ghc-lib * More fixes for warnings when compiled with ghc-lib * More fixes to build in ghc-lib * Try once again to build with ghc-lib * More fixes for ghc-lib * Fix warning with ghc-lib
1 parent 2d9314a commit 6d0b6ea

File tree

11 files changed

+301
-215
lines changed

11 files changed

+301
-215
lines changed

.hlint.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -85,6 +85,7 @@
8585
- Development.IDE.LSP.CodeAction
8686
- Development.IDE.Spans.Calculate
8787
- Development.IDE.Spans.Documentation
88+
- Development.IDE.Spans.Common
8889
- Main
8990

9091
- flags:

ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,7 @@ library
135135
Development.IDE.LSP.Outline
136136
Development.IDE.Spans.AtPoint
137137
Development.IDE.Spans.Calculate
138+
Development.IDE.Spans.Common
138139
Development.IDE.Spans.Documentation
139140
Development.IDE.Spans.Type
140141
ghc-options: -Wall -Wno-name-shadowing

src/Development/IDE/Core/Completions.hs

Lines changed: 4 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,6 @@ import Type
2525
import Var
2626
import Packages
2727
import DynFlags
28-
import ConLike
29-
import DataCon
3028

3129
import Language.Haskell.LSP.Types
3230
import Language.Haskell.LSP.Types.Capabilities
@@ -35,25 +33,9 @@ import Development.IDE.Core.CompletionsTypes
3533
import Development.IDE.Spans.Documentation
3634
import Development.IDE.GHC.Error
3735
import Development.IDE.Types.Options
38-
39-
#ifndef GHC_LIB
36+
import Development.IDE.Spans.Common
4037
import Development.IDE.GHC.Util
4138

42-
43-
safeTyThingType :: TyThing -> Maybe Type
44-
safeTyThingType thing
45-
| Just i <- safeTyThingId thing = Just (varType i)
46-
safeTyThingType (ATyCon tycon) = Just (tyConKind tycon)
47-
safeTyThingType _ = Nothing
48-
#endif
49-
50-
-- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
51-
52-
safeTyThingId :: TyThing -> Maybe Id
53-
safeTyThingId (AnId i) = Just i
54-
safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc
55-
safeTyThingId _ = Nothing
56-
5739
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
5840

5941
-- | A context of a declaration in the program
@@ -158,7 +140,7 @@ mkCompl IdeOptions{..} CI{origName,importedFrom,thingType,label,isInfix,docs} =
158140
typeText
159141
| Just t <- thingType = Just . stripForall $ T.pack (showGhc t)
160142
| otherwise = Nothing
161-
docs' = ("*Defined in '" <> importedFrom <> "'*\n") : docs
143+
docs' = ("*Defined in '" <> importedFrom <> "'*\n") : spanDocToMarkdown docs
162144
colon = if optNewColonConvention then ": " else ":: "
163145

164146
stripForall :: T.Text -> T.Text
@@ -275,12 +257,12 @@ cacheDataProducer packageState dflags tm tcs = do
275257
let typ = Just $ varType var
276258
name = Var.varName var
277259
label = T.pack $ showGhc name
278-
docs <- getDocumentationTryGhc packageState (tm:tcs) name
260+
docs <- runGhcEnv packageState $ getDocumentationTryGhc (tm:tcs) name
279261
return $ CI name (showModName curMod) typ label Nothing docs
280262

281263
toCompItem :: ModuleName -> Name -> IO CompItem
282264
toCompItem mn n = do
283-
docs <- getDocumentationTryGhc packageState (tm:tcs) n
265+
docs <- runGhcEnv packageState $ getDocumentationTryGhc (tm:tcs) n
284266
-- lookupName uses runInteractiveHsc, i.e., GHCi stuff which does not work with GHCi
285267
-- and leads to fun errors like "Cannot continue after interface file error".
286268
#ifdef GHC_LIB

src/Development/IDE/Core/CompletionsTypes.hs

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,11 @@ module Development.IDE.Core.CompletionsTypes (
55
import Control.DeepSeq
66
import qualified Data.Map as Map
77
import qualified Data.Text as T
8-
98
import GHC
10-
import Outputable
11-
import DynFlags
129

13-
-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
10+
import Development.IDE.Spans.Common
1411

15-
showGhc :: Outputable a => a -> String
16-
showGhc = showPpr unsafeGlobalDynFlags
12+
-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
1713

1814
data Backtick = Surrounded | LeftSide deriving Show
1915
data CompItem = CI
@@ -23,7 +19,7 @@ data CompItem = CI
2319
, label :: T.Text -- ^ Label to display to the user.
2420
, isInfix :: Maybe Backtick -- ^ Did the completion happen
2521
-- in the context of an infix notation.
26-
, docs :: [T.Text] -- ^ Available documentation.
22+
, docs :: SpanDoc -- ^ Available documentation.
2723
}
2824
instance Show CompItem where
2925
show CI { .. } = "CompItem { origName = \"" ++ showGhc origName ++ "\""

src/Development/IDE/Core/Rules.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -105,9 +105,7 @@ getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.T
105105
getAtPoint file pos = fmap join $ runMaybeT $ do
106106
opts <- lift getIdeOptions
107107
spans <- useE GetSpanInfo file
108-
files <- transitiveModuleDeps <$> useE GetDependencies file
109-
tms <- usesE TypeCheck (file : files)
110-
return $ AtPoint.atPoint opts (map tmrModule tms) spans pos
108+
return $ AtPoint.atPoint opts spans pos
111109

112110
-- | Goto Definition.
113111
getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
@@ -263,9 +261,11 @@ getSpanInfoRule :: Rules ()
263261
getSpanInfoRule =
264262
define $ \GetSpanInfo file -> do
265263
tc <- use_ TypeCheck file
264+
deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file
265+
tms <- mapMaybe (fmap fst) <$> usesWithStale TypeCheck (transitiveModuleDeps deps)
266266
(fileImports, _) <- use_ GetLocatedImports file
267267
packageState <- hscEnv <$> use_ GhcSession file
268-
x <- liftIO $ getSrcSpanInfos packageState fileImports tc
268+
x <- liftIO $ getSrcSpanInfos packageState fileImports tc tms
269269
return ([], Just x)
270270

271271
-- Typechecks a module.

src/Development/IDE/Spans/AtPoint.hs

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@ module Development.IDE.Spans.AtPoint (
88
, gotoDefinition
99
) where
1010

11-
import Development.IDE.Spans.Documentation
1211
import Development.IDE.GHC.Error
1312
import Development.IDE.GHC.Orphans()
1413
import Development.IDE.Types.Location
@@ -18,7 +17,8 @@ import Development.Shake
1817
import Development.IDE.GHC.Util
1918
import Development.IDE.GHC.Compat
2019
import Development.IDE.Types.Options
21-
import Development.IDE.Spans.Type as SpanInfo
20+
import Development.IDE.Spans.Type as SpanInfo
21+
import Development.IDE.Spans.Common (spanDocToMarkdown)
2222

2323
-- GHC API imports
2424
import Avail
@@ -50,40 +50,42 @@ gotoDefinition getHieFile ideOpts pkgState srcSpans pos =
5050
-- | Synopsis for the name at a given position.
5151
atPoint
5252
:: IdeOptions
53-
-> [TypecheckedModule]
5453
-> [SpanInfo]
5554
-> Position
5655
-> Maybe (Maybe Range, [T.Text])
57-
atPoint IdeOptions{..} tcs srcSpans pos = do
56+
atPoint IdeOptions{..} srcSpans pos = do
5857
firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint pos srcSpans
5958
return (Just (range firstSpan), hoverInfo firstSpan)
6059
where
6160
-- Hover info for types, classes, type variables
62-
hoverInfo SpanInfo{spaninfoType = Nothing , ..} =
63-
documentation <> (wrapLanguageSyntax <$> name <> kind) <> location
61+
hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs , ..} =
62+
(wrapLanguageSyntax <$> name) <> location <> spanDocToMarkdown docs
6463
where
65-
documentation = findDocumentation mbName
6664
name = [maybe shouldNotHappen showName mbName]
6765
location = [maybe shouldNotHappen definedAt mbName]
68-
kind = [] -- TODO
6966
shouldNotHappen = "ghcide: did not expect a type level component without a name"
7067
mbName = getNameM spaninfoSource
7168

7269
-- Hover info for values/data
73-
hoverInfo SpanInfo{spaninfoType = (Just typ), ..} =
74-
documentation <> (wrapLanguageSyntax <$> nameOrSource <> typeAnnotation) <> location
70+
hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} =
71+
(wrapLanguageSyntax <$> nameOrSource) <> location <> spanDocToMarkdown docs
7572
where
7673
mbName = getNameM spaninfoSource
77-
documentation = findDocumentation mbName
78-
typeAnnotation = [colon <> showName typ]
79-
nameOrSource = [maybe literalSource qualifyNameIfPossible mbName]
80-
literalSource = "" -- TODO: literals: display (length-limited) source
74+
typeAnnotation = colon <> showName typ
75+
expr = case spaninfoSource of
76+
Named n -> qualifyNameIfPossible n
77+
Lit l -> crop $ T.pack l
78+
_ -> ""
79+
nameOrSource = [expr <> "\n" <> typeAnnotation]
8180
qualifyNameIfPossible name' = modulePrefix <> showName name'
8281
where modulePrefix = maybe "" (<> ".") (getModuleNameAsText name')
8382
location = [maybe "" definedAt mbName]
8483

85-
findDocumentation = maybe [] (getDocumentation tcs)
86-
definedAt name = "**Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "**\n"
84+
definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*\n"
85+
86+
crop txt
87+
| T.length txt > 50 = T.take 46 txt <> " ..."
88+
| otherwise = txt
8789

8890
range SpanInfo{..} = Range
8991
(Position spaninfoStartLine spaninfoStartCol)
@@ -112,6 +114,7 @@ locationsAtPoint getHieFile IdeOptions{..} pkgState pos =
112114
where getSpan :: SpanSource -> m (Maybe SrcSpan)
113115
getSpan NoSource = pure Nothing
114116
getSpan (SpanS sp) = pure $ Just sp
117+
getSpan (Lit _) = pure Nothing
115118
getSpan (Named name) = case nameSrcSpan name of
116119
sp@(RealSrcSpan _) -> pure $ Just sp
117120
sp@(UnhelpfulSpan _) -> runMaybeT $ do

0 commit comments

Comments
 (0)