2154bb2 · ghcide · git.iko.soy

git.iko.soy/ghcide

Show constraints on hover (#338)

commit2154bb2eafbb021d169cd85a47d7558c4db28328 authorAlejandro Serrano <trupill@gmail.com> dateWed 22 Jan 2020, 10:40 (7 years ago) parentc147e62

6 files changed+45−14

compare with master

unifiedsplit

src/Development/IDE/Core/RuleTypes.hs+1−1 src/Development/IDE/Core/Rules.hs+2−1 src/Development/IDE/Spans/AtPoint.hs+17−6 src/Development/IDE/Spans/Calculate.hs+13−3 src/Development/IDE/Spans/Type.hs+10−1 test/exe/Main.hs+2−2

src/Development/IDE/Core/RuleTypes.hs+1−1

@@ -63,7 +63,7 @@ instance NFData TcModuleResult where

6363type instance RuleResult TypeCheck = TcModuleResult

6464

6565-- | Information about what spans occur where, requires TypeCheck

66−type instance RuleResult GetSpanInfo = [SpanInfo]

66+type instance RuleResult GetSpanInfo = SpansInfo

6767

6868-- | Convert to Core, requires TypeCheck*

6969type instance RuleResult GenerateCore = (SafeHaskellMode, CgGuts, ModDetails)

src/Development/IDE/Core/Rules.hs+2−1

@@ -54,6 +54,7 @@ import qualified Data.Text as T

5454import Development.IDE.GHC.Error

5555import Development.Shake hiding (Diagnostic)

5656import Development.IDE.Core.RuleTypes

57+import Development.IDE.Spans.Type

5758

5859import GHC hiding (parseModule, typecheckModule)

5960import qualified GHC.LanguageExtensions as LangExt

@@ -114,7 +115,7 @@ getDefinition file pos = fmap join $ runMaybeT $ do

114115 spans <- useE GetSpanInfo file

115116 pkgState <- hscEnv <$> useE GhcSession file

116117 let getHieFile x = useNoFile (GetHieFile x)

117− lift $ AtPoint.gotoDefinition getHieFile opts pkgState spans pos

118+ lift $ AtPoint.gotoDefinition getHieFile opts pkgState (spansExprs spans) pos

118119

119120-- | Parse the contents of a daml file.

120121getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)

src/Development/IDE/Spans/AtPoint.hs+17−6

@@ -27,6 +27,8 @@ import FastString

2727import Name

2828import Outputable hiding ((<>))

2929import SrcLoc

30+import Type

31+import VarSet

3032

3133import Control.Monad.Extra

3234import Control.Monad.Trans.Maybe

@@ -50,15 +52,16 @@ gotoDefinition getHieFile ideOpts pkgState srcSpans pos =

5052-- | Synopsis for the name at a given position.

5153atPoint

5254 :: IdeOptions

53− -> [SpanInfo]

55+ -> SpansInfo

5456 -> Position

5557 -> Maybe (Maybe Range, [T.Text])

56−atPoint IdeOptions{..} srcSpans pos = do

58+atPoint IdeOptions{..} (SpansInfo srcSpans cntsSpans) pos = do

5759 firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint pos srcSpans

58− return (Just (range firstSpan), hoverInfo firstSpan)

60+ let constraintsAtPoint = mapMaybe spaninfoType (spansAtPoint pos cntsSpans)

61+ return (Just (range firstSpan), hoverInfo firstSpan constraintsAtPoint)

5962 where

6063 -- Hover info for types, classes, type variables

61− hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs , ..} =

64+ hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs , ..} _ =

6265 (wrapLanguageSyntax <$> name) <> location <> spanDocToMarkdown docs

6366 where

6467 name = [maybe shouldNotHappen showName mbName]

@@ -67,11 +70,10 @@ atPoint IdeOptions{..} srcSpans pos = do

6770 mbName = getNameM spaninfoSource

6871

6972 -- Hover info for values/data

70− hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} =

73+ hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} cnts =

7174 (wrapLanguageSyntax <$> nameOrSource) <> location <> spanDocToMarkdown docs

7275 where

7376 mbName = getNameM spaninfoSource

74− typeAnnotation = colon <> showName typ

7577 expr = case spaninfoSource of

7678 Named n -> qualifyNameIfPossible n

7779 Lit l -> crop $ T.pack l

@@ -81,6 +83,15 @@ atPoint IdeOptions{..} srcSpans pos = do

8183 where modulePrefix = maybe "" (<> ".") (getModuleNameAsText name')

8284 location = [maybe "" definedAt mbName]

8385

86+ thisFVs = tyCoVarsOfType typ

87+ constraintsOverFVs = filter (\cnt -> not (tyCoVarsOfType cnt `disjointVarSet` thisFVs)) cnts

88+ constraintsT = T.intercalate ", " (map showName constraintsOverFVs)

89+

90+ typeAnnotation = case constraintsOverFVs of

91+ [] -> colon <> showName typ

92+ [_] -> colon <> constraintsT <> "\n=> " <> showName typ

93+ _ -> colon <> "(" <> constraintsT <> ")\n=> " <> showName typ

94+

8495 definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*\n"

8596

8697 crop txt

src/Development/IDE/Spans/Calculate.hs+13−3

@@ -52,7 +52,7 @@ getSrcSpanInfos

5252 -> [(Located ModuleName, Maybe NormalizedFilePath)]

5353 -> TcModuleResult

5454 -> [TcModuleResult]

55− -> IO [SpanInfo]

55+ -> IO SpansInfo

5656getSrcSpanInfos env imports tc tms =

5757 runGhcEnv env $

5858 getSpanInfo imports (tmrModule tc) (map tmrModule tms)

@@ -62,7 +62,7 @@ getSpanInfo :: GhcMonad m

6262 => [(Located ModuleName, Maybe NormalizedFilePath)] -- ^ imports

6363 -> TypecheckedModule

6464 -> [TypecheckedModule]

65− -> m [SpanInfo]

65+ -> m SpansInfo

6666getSpanInfo mods tcm tcms =

6767 do let tcs = tm_typechecked_source tcm

6868 bs = listifyAllSpans tcs :: [LHsBind GhcTc]

@@ -78,13 +78,16 @@ getSpanInfo mods tcm tcms =

7878 let imports = importInfo mods

7979 let exports = getExports tcm

8080 let exprs = addEmptyInfo exports ++ addEmptyInfo imports ++ concat bts ++ concat tts ++ catMaybes (ets ++ pts)

81− return (mapMaybe toSpanInfo (sortBy cmp exprs))

81+ let constraints = map constraintToInfo (concatMap getConstraintsLHsBind bs)

82+ return $ SpansInfo (mapMaybe toSpanInfo (sortBy cmp exprs))

83+ (mapMaybe toSpanInfo (sortBy cmp constraints))

8284 where cmp (_,a,_,_) (_,b,_,_)

8385 | a `isSubspanOf` b = LT

8486 | b `isSubspanOf` a = GT

8587 | otherwise = compare (srcSpanStart a) (srcSpanStart b)

8688

8789 addEmptyInfo = map (\(a,b) -> (a,b,Nothing,emptySpanDoc))

90+ constraintToInfo (sp, ty) = (SpanS sp, sp, Just ty, emptySpanDoc)

8891

8992-- | The locations in the typechecked module are slightly messed up in some cases (e.g. HsMatchContext always

9093-- points to the first match) whereas the parsed module has the correct locations.

@@ -130,6 +133,13 @@ getTypeLHsBind tms _ (L _spn FunBind{fun_id = pid,fun_matches = MG{}}) = do

130133 return [(Named name, getLoc pid, Just (varType (unLoc pid)), docs)]

131134getTypeLHsBind _ _ _ = return []

132135

136+-- | Get information about constraints

137+getConstraintsLHsBind :: LHsBind GhcTc

138+ -> [(SrcSpan, Type)]

139+getConstraintsLHsBind (L spn AbsBinds { abs_ev_vars = vars })

140+ = map (\v -> (spn, varType v)) vars

141+getConstraintsLHsBind _ = []

142+

133143-- | Get the name and type of an expression.

134144getTypeLHsExpr :: (GhcMonad m)

135145 => [TypecheckedModule]

src/Development/IDE/Spans/Type.hs+10−1

@@ -6,7 +6,8 @@

66-- | Types used separate to GHCi vanilla.

88module Development.IDE.Spans.Type(

9− SpanInfo(..)

9+ SpansInfo(..)

10+ , SpanInfo(..)

1011 , SpanSource(..)

1112 , getNameM

1213 ) where

@@ -17,6 +18,14 @@ import OccName

1718import Development.IDE.GHC.Util

1819import Development.IDE.Spans.Common

1920

21+data SpansInfo =

22+ SpansInfo { spansExprs :: [SpanInfo]

23+ , spansConstraints :: [SpanInfo] }

24+ deriving Show

25+

26+instance NFData SpansInfo where

27+ rnf (SpansInfo e c) = liftRnf rnf e `seq` liftRnf rnf c

28+

2029-- | Type of some span of source code. Most of these fields are

2130-- unboxed but Haddock doesn't show that.

2231data SpanInfo =

test/exe/Main.hs+2−2

@@ -1146,7 +1146,7 @@ findDefinitionAndHoverTests = let

11461146 mclL37 = Position 37 1

11471147 spaceL37 = Position 37 24 ; space = [ExpectNoDefinitions, ExpectHoverText [":: Char"]]

11481148 docL41 = Position 41 1 ; doc = [ExpectHoverText ["Recognizable docs: kpqz"]]

1149− ; constr = [ExpectHoverText ["Monad m =>"]]

1149+ ; constr = [ExpectHoverText ["Monad m"]]

11501150 eitL40 = Position 40 28 ; kindE = [ExpectHoverText [":: * -> * -> *\n"]]

11511151 intL40 = Position 40 34 ; kindI = [ExpectHoverText [":: *\n"]]

11521152 tvrL40 = Position 40 37 ; kindV = [ExpectHoverText [":: * -> *\n"]]

@@ -1191,7 +1191,7 @@ findDefinitionAndHoverTests = let

11911191 , test no yes chrL36 litC "literal Char in hover info #274"

11921192 , test no broken txtL8 litT "literal Text in hover info #274"

11931193 , test no broken lstL43 litL "literal List in hover info #274"

1194− , test no broken docL41 constr "type constraint in hover info #283"

1194+ , test no yes docL41 constr "type constraint in hover info #283"

11951195 , test broken broken outL45 outSig "top-level signature #310"

11961196 , test broken broken innL48 innSig "inner signature #310"

11971197 ]