bbb75c2 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Fix #248 and #250 (#267)

bbb75c2Jacek Generowicz7 years ago

src/Development/IDE/Spans/AtPoint.hs+41−23

compare with master

unifiedsplit

@@ -55,33 +55,52 @@ atPoint

55 -> [SpanInfo]

56 -> Position

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

58−atPoint IdeOptions{..} tcs srcSpans pos = do

58+atPoint IdeOptions{..} tcs pos srcSpans = do

59− SpanInfo{..} <- listToMaybe $ orderSpans $ spansAtPoint pos srcSpans

59+ firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint srcSpans pos

60− ty <- spaninfoType

61− let mbName = getNameM spaninfoSource

62− mbDefinedAt = fmap (\name -> "**Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "**\n") mbName

63− docInfo = maybe [] (\name -> getDocumentation name tcs) mbName

64− range = Range

65− (Position spaninfoStartLine spaninfoStartCol)

66− (Position spaninfoEndLine spaninfoEndCol)

67− colon = if optNewColonConvention then ":" else "::"

68− wrapLanguageSyntax x = T.unlines [ "```" <> T.pack optLanguageSyntax, x, "```"]

69− typeSig = wrapLanguageSyntax $ case mbName of

70− Nothing -> colon <> " " <> showName ty

71− Just name ->

72− let modulePrefix = maybe "" (<> ".") (getModuleNameAsText name)

73− in modulePrefix <> showName name <> "\n " <> colon <> " " <> showName ty

74− hoverInfo = docInfo <> [typeSig] <> maybeToList mbDefinedAt

75− return (Just range, hoverInfo)

60+ return (Just (range firstSpan), hoverInfo firstSpan)

76 where

61 where

62+ -- Hover info for types, classes, type variables

63+ hoverInfo SpanInfo{spaninfoType = Nothing , ..} =

64+ documentation <> (wrapLanguageSyntax <$> name <> kind) <> location

65+ where

66+ documentation = findDocumentation mbName

67+ name = [maybe shouldNotHappen showName mbName]

68+ location = [maybe shouldNotHappen definedAt mbName]

69+ kind = [] -- TODO

70+ shouldNotHappen = "ghcide: did not expect a type level component without a name"

71+ mbName = getNameM spaninfoSource

72+

73+ -- Hover info for values/data

74+ hoverInfo SpanInfo{spaninfoType = (Just typ), ..} =

75+ documentation <> (wrapLanguageSyntax <$> nameOrSource <> typeAnnotation) <> location

76+ where

77+ mbName = getNameM spaninfoSource

78+ documentation = findDocumentation mbName

79+ typeAnnotation = [colon <> showName typ]

80+ nameOrSource = [maybe literalSource qualifyNameIfPossible mbName]

81+ literalSource = "" -- TODO: literals: display (length-limited) source

82+ qualifyNameIfPossible name' = modulePrefix <> showName name'

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

84+ location = [maybe "" definedAt mbName]

85+

86+ findDocumentation = maybe [] (getDocumentation tcs)

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

88+

89+ range SpanInfo{..} = Range

90+ (Position spaninfoStartLine spaninfoStartCol)

91+ (Position spaninfoEndLine spaninfoEndCol)

92+

93+ colon = if optNewColonConvention then ": " else ":: "

94+ wrapLanguageSyntax x = T.unlines [ "```" <> T.pack optLanguageSyntax, x, "```"]

95+

77 -- NOTE(RJR): This is a bit hacky.

96 -- NOTE(RJR): This is a bit hacky.

78 -- We don't want to show the user type signatures generated from Eq and Show

97 -- We don't want to show the user type signatures generated from Eq and Show

79 -- instances, as they do not appear in the source program.

98 -- instances, as they do not appear in the source program.

80 -- However the user could have written an `==` or `show` function directly,

99 -- However the user could have written an `==` or `show` function directly,

81 -- in which case we still want to show information for that.

100 -- in which case we still want to show information for that.

82 -- Hence we just move such information later in the list of spans.

101 -- Hence we just move such information later in the list of spans.

83− orderSpans :: [SpanInfo] -> [SpanInfo]

102+ deEmpasizeGeneratedEqShow :: [SpanInfo] -> [SpanInfo]

84− orderSpans = uncurry (++) . partition (not . isTypeclassDeclSpan)

103+ deEmpasizeGeneratedEqShow = uncurry (++) . partition (not . isTypeclassDeclSpan)

85 isTypeclassDeclSpan :: SpanInfo -> Bool

104 isTypeclassDeclSpan :: SpanInfo -> Bool

86 isTypeclassDeclSpan spanInfo =

105 isTypeclassDeclSpan spanInfo =

87 case getNameM (spaninfoSource spanInfo) of

106 case getNameM (spaninfoSource spanInfo) of

@@ -90,9 +109,7 @@ atPoint IdeOptions{..} tcs srcSpans pos = do

109

91locationsAtPoint :: forall m . MonadIO m => (FilePath -> m (Maybe HieFile)) -> IdeOptions -> HscEnv -> Position -> [SpanInfo] -> m [Location]

110locationsAtPoint :: forall m . MonadIO m => (FilePath -> m (Maybe HieFile)) -> IdeOptions -> HscEnv -> Position -> [SpanInfo] -> m [Location]

92locationsAtPoint getHieFile IdeOptions{..} pkgState pos =

111locationsAtPoint getHieFile IdeOptions{..} pkgState pos =

93− fmap (map srcSpanToLocation) .

94− mapMaybeM (getSpan . spaninfoSource) .

112+ fmap (map srcSpanToLocation) . mapMaybeM (getSpan . spaninfoSource) . spansAtPoint pos

95− spansAtPoint pos

96 where getSpan :: SpanSource -> m (Maybe SrcSpan)

113 where getSpan :: SpanSource -> m (Maybe SrcSpan)

97 getSpan NoSource = pure Nothing

114 getSpan NoSource = pure Nothing

98 getSpan (SpanS sp) = pure $ Just sp

115 getSpan (SpanS sp) = pure $ Just sp

@@ -121,6 +138,7 @@ locationsAtPoint getHieFile IdeOptions{..} pkgState pos =

121 setFileName f (RealSrcSpan span) = RealSrcSpan (span { srcSpanFile = mkFastString f })

138 setFileName f (RealSrcSpan span) = RealSrcSpan (span { srcSpanFile = mkFastString f })

122 setFileName _ span@(UnhelpfulSpan _) = span

139 setFileName _ span@(UnhelpfulSpan _) = span

123

140

141+-- | Filter out spans which do not enclose a given point

124spansAtPoint :: Position -> [SpanInfo] -> [SpanInfo]

142spansAtPoint :: Position -> [SpanInfo] -> [SpanInfo]

125spansAtPoint pos = filter atp where

143spansAtPoint pos = filter atp where

126 line = _line pos

144 line = _line pos

src/Development/IDE/Spans/Documentation.hs+3−3

@@ -18,8 +18,8 @@ import SrcLoc

20getDocumentation

21− :: Name -- ^ The name you want documentation for.

22− -> [TypecheckedModule] -- ^ All of the possible modules it could be defined in.

21+ :: [TypecheckedModule] -- ^ All of the possible modules it could be defined in.

22+ -> Name -- ^ The name you want documentation for.

23 -> [T.Text]

24-- This finds any documentation between the name you want

25-- documentation for and the one before it. This is only an

@@ -28,7 +28,7 @@ getDocumentation

28-- may be edge cases where it is very wrong).

29-- TODO : Build a version of GHC exactprint to extract this information

30-- more accurately.

31−getDocumentation targetName tcs = fromMaybe [] $ do

31+getDocumentation tcs targetName = fromMaybe [] $ do

32 -- Find the module the target is defined in.

33 targetNameSpan <- realSpan $ nameSrcSpan targetName

34 tc <-

test/data/GotoHover.hs+3−3

@@ -19,11 +19,11 @@ a +! b = a - b

19hhh (Just a) (><) = a >< a

20iii a b = a `b` a

21jjj s = pack $ s <> s

22−class Class a where

22+class MyClass a where

23 method :: a -> Int

24−instance Class Int where

24+instance MyClass Int where

25 method = succ

26−kkk :: Class a => Int -> a -> Int

26+kkk :: MyClass a => Int -> a -> Int

27kkk n c = n + method c

29doBind :: Maybe ()

test/exe/Main.hs+11−11

@@ -825,17 +825,17 @@ findDefinitionAndHoverTests = let

825 aaaL14 = Position 14 20 ; aaa = [mkR 7 0 7 3]

826 dcL7 = Position 7 11 ; tcDC = [mkR 3 23 5 16]

827 dcL12 = Position 12 11 ;

828− xtcL5 = Position 5 11 ; xtc = [ExpectExternFail]

828+ xtcL5 = Position 5 11 ; xtc = [ExpectExternFail, ExpectHoverText ["Int", "Defined in ‘GHC.Types’"]]

829− tcL6 = Position 6 11 ; tcData = [mkR 3 0 5 16]

829+ tcL6 = Position 6 11 ; tcData = [mkR 3 0 5 16, ExpectHoverText ["TypeConstructor", "GotoHover.hs:4:1"]]

830 vvL16 = Position 16 12 ; vv = [mkR 16 4 16 6]

831 opL16 = Position 16 15 ; op = [mkR 17 2 17 4]

832 opL18 = Position 18 22 ; opp = [mkR 18 13 18 17]

833 aL18 = Position 18 20 ; apmp = [mkR 18 10 18 11]

834 b'L19 = Position 19 13 ; bp = [mkR 19 6 19 7]

835− xvL20 = Position 20 8 ; xvMsg = [ExpectHoverText ["Data.Text.pack", ":: String -> Text"], ExpectExternFail]

835+ xvL20 = Position 20 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["Data.Text.pack", ":: String -> Text"]]

836− clL23 = Position 23 11 ; cls = [mkR 21 0 22 20]

836+ clL23 = Position 23 11 ; cls = [mkR 21 0 22 20, ExpectHoverText ["MyClass", "GotoHover.hs:22:1"]]

837 clL25 = Position 25 9

838− eclL15 = Position 15 8 ; ecls = [ExpectHoverText ["Num"], ExpectExternFail]

838+ eclL15 = Position 15 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ‘GHC.Num’"]]

839 dnbL29 = Position 29 18 ; dnb = [ExpectHoverText [":: ()"], mkR 29 12 29 21]

840 dnbL30 = Position 30 23

841 lcbL33 = Position 33 26 ; lcb = [ExpectHoverText [":: Char"], mkR 33 26 33 27]

@@ -852,24 +852,24 @@ findDefinitionAndHoverTests = let

852 , test yes yes aaaL14 aaa "top-level name" -- 120

853 , test broken broken dcL7 tcDC "data constructor record #247"

854 , test yes yes dcL12 tcDC "data constructor plain" -- 121

855− , test yes broken tcL6 tcData "type constructor #249" -- 147

855+ , test yes yes tcL6 tcData "type constructor #248" -- 147

856− , test broken broken xtcL5 xtc "type constructor external #249"

856+ , test broken yes xtcL5 xtc "type constructor external #248,249"

857 , test broken yes xvL20 xvMsg "value external package #249" -- 120

858 , test yes yes vvL16 vv "plain parameter" -- 120

859 , test yes yes aL18 apmp "pattern match name" -- 120

860 , test yes yes opL16 op "top-level operator" -- 120, 123

861 , test yes yes opL18 opp "parameter operator" -- 120

862 , test yes yes b'L19 bp "name in backticks" -- 120

863− , test yes broken clL23 cls "class in instance declaration #250"

863+ , test yes yes clL23 cls "class in instance declaration #250"

864− , test yes broken clL25 cls "class in signature #250" -- 147

864+ , test yes yes clL25 cls "class in signature #250" -- 147

865− , test broken broken eclL15 ecls "external class in signature #249,250"

865+ , test broken yes eclL15 ecls "external class in signature #249,250"

866 , test yes yes dnbL29 dnb "do-notation bind" -- 137

867 , test yes yes dnbL30 dnb "do-notation lookup"

868 , test yes yes lcbL33 lcb "listcomp bind" -- 137

869 , test yes yes lclL33 lcb "listcomp lookup"

870 , test yes yes mclL36 mcl "top-level fn 1st clause"

871 , test yes yes mclL37 mcl "top-level fn 2nd clause #246"

872− , test no broken docL40 doc "documentation"

872+ , test no broken docL40 doc "documentation #7"

873 ]

874 where yes, broken :: (TestTree -> Maybe TestTree)

875 yes = Just -- test should run and pass