git.iko.soy/ghcide
on 210de4e help sign in
ghcide/src/Development/IDE/Functions/AtPoint.hs
139 lines 6.0 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE OverloadedStrings #-}
5-- | Gives information about symbols at a given point in DAML files.
6-- These are all pure functions that should execute quickly.
7module Development.IDE.Functions.AtPoint (
8 atPoint
9 , gotoDefinition
10 ) where
12import Development.IDE.Functions.Documentation
13import Development.IDE.Functions.GHCError
14import Development.IDE.Orphans()
16-- DAML compiler and infrastructure
17import Development.Shake
18import Development.IDE.UtilGHC
19import Development.IDE.Compat
20import Development.IDE.State.Shake
21import Development.IDE.State.RuleTypes
22import Development.IDE.Types.Diagnostics
23import Development.IDE.Types.LSP
24import Development.IDE.Types.Options
25import Development.IDE.Types.SpanInfo as SpanInfo
27-- GHC API imports
28import Avail
29import GHC
30import DynFlags
31import FastString
32import Name
33import Outputable hiding ((<>))
35import Control.Monad.Extra
36import Control.Monad.Trans.Maybe
37import Data.Maybe
38import Data.List
39import qualified Data.Text as T
41-- | Locate the definition of the name at a given position.
42gotoDefinition
43 :: IdeOptions
44 -> HscEnv
45 -> [SpanInfo]
46 -> Position
47 -> Action (Maybe Location)
48gotoDefinition ideOpts pkgState srcSpans pos =
49 listToMaybe <$> locationsAtPoint ideOpts pkgState pos srcSpans
51-- | Synopsis for the name at a given position.
52atPoint
53 :: [TypecheckedModule]
54 -> [SpanInfo]
55 -> Position
56 -> Maybe (Maybe Range, [HoverText])
57atPoint tcs srcSpans pos = do
58 SpanInfo{..} <- listToMaybe $ orderSpans $ spansAtPoint pos srcSpans
59 ty <- spaninfoType
60 let mbName = getNameM spaninfoSource
61 mbDefinedAt = fmap (\name -> HoverMarkdown $ "**Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "**\n") mbName
62 mbDocs = fmap (\name -> getDocumentation name tcs) mbName
63 docInfo = maybe [] (map HoverMarkdown . docHeaders) mbDocs
64 range = Range
65 (Position spaninfoStartLine spaninfoStartCol)
66 (Position spaninfoEndLine spaninfoEndCol)
67 typeSig = HoverDamlCode $ case mbName of
68 Nothing -> ": " <> showName ty
69 Just name ->
70 let modulePrefix = maybe "" (<> ".") (getModuleNameAsText name)
71 in modulePrefix <> showName name <> "\n : " <> showName ty
72 hoverInfo = docInfo <> [typeSig] <> maybeToList mbDefinedAt
73 return (Just range, hoverInfo)
74 where
75 -- NOTE(RJR): This is a bit hacky.
76 -- We don't want to show the user type signatures generated from Eq and Show
77 -- instances, as they do not appear in the source program.
78 -- However the user could have written an `==` or `show` function directly,
79 -- in which case we still want to show information for that.
80 -- Hence we just move such information later in the list of spans.
81 orderSpans :: [SpanInfo] -> [SpanInfo]
82 orderSpans = uncurry (++) . partition (not . isTypeclassDeclSpan)
83 isTypeclassDeclSpan :: SpanInfo -> Bool
84 isTypeclassDeclSpan spanInfo =
85 case getNameM (spaninfoSource spanInfo) of
86 Just name -> any (`isInfixOf` show name) ["==", "showsPrec"]
87 Nothing -> False
89locationsAtPoint :: IdeOptions -> HscEnv -> Position -> [SpanInfo] -> Action [Location]
90locationsAtPoint IdeOptions{..} pkgState pos =
91 fmap (map srcSpanToLocation) .
92 mapMaybeM (getSpan . spaninfoSource) .
93 spansAtPoint pos
94 where getSpan :: SpanSource -> Action (Maybe SrcSpan)
95 getSpan NoSource = pure Nothing
96 getSpan (Span sp) = pure $ Just sp
97 getSpan (Named name) = case nameSrcSpan name of
98 sp@(RealSrcSpan _) -> pure $ Just sp
99 UnhelpfulSpan _ -> runMaybeT $ do
100 -- This case usually arises when the definition is in an external package.
101 -- In this case the interface files contain garbage source spans
102 -- so we instead read the .hie files to get useful source spans.
103 let mod = nameModule name
104 let unitId = moduleUnitId mod
105 pkgConfig <- MaybeT $ pure $ lookupPackageConfig unitId pkgState
106 hiePath <- MaybeT $ liftIO $ optLocateHieFile optPkgLocationOpts pkgConfig mod
107 hieFile <- MaybeT $ use (GetHieFile hiePath) ""
108 avail <- MaybeT $ pure $ listToMaybe (filterAvails (eqName name) $ hie_exports hieFile)
109 srcPath <- MaybeT $ liftIO $ optLocateSrcFile optPkgLocationOpts pkgConfig mod
110 -- The location will point to the source file used during compilation.
111 -- This file might no longer exists and even if it does the path will be relative
112 -- to the compilation directory which we don’t know.
113 let span = setFileName srcPath $ nameSrcSpan $ availName avail
114 pure span
115 -- We ignore uniques and source spans and only compare the name and the module.
116 eqName :: Name -> Name -> Bool
117 eqName n n' = nameOccName n == nameOccName n' && nameModule n == nameModule n'
118 setFileName f (RealSrcSpan span) = RealSrcSpan (span { srcSpanFile = mkFastString f })
119 setFileName _ span@(UnhelpfulSpan _) = span
121spansAtPoint :: Position -> [SpanInfo] -> [SpanInfo]
122spansAtPoint pos = filter atp where
123 line = _line pos + 1
124 cha = _character pos + 1
125 atp SpanInfo{..} = spaninfoStartLine <= line
126 && spaninfoEndLine >= line
127 && spaninfoStartCol <= cha
128 && spaninfoEndCol >= cha
130showName :: Outputable a => a -> T.Text
131showName = T.pack . prettyprint
132 where
133 prettyprint x = renderWithStyle unsafeGlobalDynFlags (ppr x) style
134 style = mkUserStyle unsafeGlobalDynFlags neverQualify AllTheWay
136getModuleNameAsText :: Name -> Maybe T.Text
137getModuleNameAsText n = do
138 m <- nameModule_maybe n
139 return . T.pack . moduleNameString $ moduleName m