1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
|
{-# LANGUAGE BangPatterns #-}
-- | Find type/location information.
module GhciFind
(findType,findLoc,findNameUses)
where
import Control.Monad
import Data.List
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import FastString
import GHC
import GhcMonad
import GhciInfo (showppr)
import GhciTypes
import Name
import SrcLoc
import System.Directory
import Var
-- | Find any uses of the given identifier in the codebase.
findNameUses :: (GhcMonad m)
=> Map ModuleName ModInfo
-> FilePath
-> String
-> Int
-> Int
-> Int
-> Int
-> m (Either String [SrcSpan])
findNameUses infos fp string sl sc el ec =
do mname <- guessModule infos fp
case mname of
Nothing ->
return (Left "Couldn't guess that module name. Does it exist?")
Just name ->
case M.lookup name infos of
Nothing ->
return (Left ("No module info for the current file! Try loading it?"))
Just info ->
do mname' <- findName infos info string sl sc el ec
case mname' of
Left e -> return (Left e)
Right name' ->
case getSrcSpan name' of
UnhelpfulSpan{} ->
do d <- getSessionDynFlags
return (Left ("Found a name, but no location information. The module is: " ++
maybe "<unknown>"
(showppr d . moduleName)
(nameModule_maybe name')))
span' ->
return (Right (stripSurrounding
(span' :
map makeSrcSpan
(filter ((== Just name') .
fmap getName .
spaninfoVar)
(modinfoSpans info)))))
where makeSrcSpan (SpanInfo sl' sc' el' ec' _ _) =
RealSrcSpan
(mkRealSrcSpan
(mkRealSrcLoc (mkFastString fp)
sl'
(1 + sc'))
(mkRealSrcLoc (mkFastString fp)
el'
(1 + ec')))
-- | Strip out spans which surrounding other spans in a parent->child
-- fashion. Those are useless.
stripSurrounding :: [SrcSpan] -> [SrcSpan]
stripSurrounding xs =
mapMaybe (\x -> if any (\y -> overlaps x y && x /= y) xs
then Nothing
else Just x)
xs
-- | Does x overlap y in x `overlaps` y?
overlaps :: SrcSpan -> SrcSpan -> Bool
overlaps y x =
case (x,y) of
(RealSrcSpan x',RealSrcSpan y') ->
realSrcSpanStart y' <= realSrcSpanStart x' &&
realSrcSpanEnd y' >= realSrcSpanEnd x'
_ -> False
-- | Try to find the location of the given identifier at the given
-- position in the module.
findLoc :: (GhcMonad m)
=> Map ModuleName ModInfo
-> FilePath
-> String
-> Int
-> Int
-> Int
-> Int
-> m (Either String SrcSpan)
findLoc infos fp string sl sc el ec =
do mname <- guessModule infos fp
case mname of
Nothing ->
return (Left "Couldn't guess that module name. Does it exist?")
Just name ->
case M.lookup name infos of
Nothing ->
return (Left ("No module info for the current file! Try loading it?"))
Just info ->
do mname' <- findName infos info string sl sc el ec
d <- getSessionDynFlags
case mname' of
Left reason ->
return (Left reason)
Right name' ->
case getSrcSpan name' of
UnhelpfulSpan{} ->
return (Left ("Found a name, but no location information. The module is: " ++
maybe "<unknown>"
(showppr d . moduleName)
(nameModule_maybe name')))
span' ->
return (Right span')
-- | Try to resolve the name located at the given position, or
-- otherwise resolve based on the current module's scope.
findName :: GhcMonad m
=> Map ModuleName ModInfo
-> ModInfo
-> String
-> Int
-> Int
-> Int
-> Int
-> m (Either String Name)
findName infos mi string sl sc el ec =
case resolveName (modinfoSpans mi)
sl
sc
el
ec of
Nothing -> tryExternalModuleResolution
Just name ->
case getSrcSpan name of
UnhelpfulSpan{} -> tryExternalModuleResolution
_ -> return (Right (getName name))
where tryExternalModuleResolution =
case find (matchName string)
(fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of
Nothing ->
return (Left "Couldn't resolve to any modules.")
Just imported -> resolveNameFromModule infos imported
matchName :: String -> Name -> Bool
matchName str name =
str ==
occNameString (getOccName name)
-- | Try to resolve the name from another (loaded) module's exports.
resolveNameFromModule :: GhcMonad m
=> Map ModuleName ModInfo
-> Name
-> m (Either String Name)
resolveNameFromModule infos name =
do d <- getSessionDynFlags
case nameModule_maybe name of
Nothing ->
return (Left ("No module for " ++
showppr d name))
Just modL ->
do case M.lookup (moduleName modL) infos of
Nothing ->
do (return (Left (showppr d (modulePackageKey modL) ++ ":" ++
showppr d modL)))
Just info ->
case find (matchName name)
(modInfoExports (modinfoInfo info)) of
Just name' ->
return (Right name')
Nothing ->
return (Left "No matching export in any local modules.")
where matchName :: Name -> Name -> Bool
matchName x y =
occNameString (getOccName x) ==
occNameString (getOccName y)
-- | Try to resolve the type display from the given span.
resolveName :: [SpanInfo] -> Int -> Int -> Int -> Int -> Maybe Var
resolveName spans' sl sc el ec =
listToMaybe (mapMaybe spaninfoVar (filter inside (reverse spans')))
where inside (SpanInfo sl' sc' el' ec' _ _) =
((sl' == sl && sc' >= sc) || (sl' > sl)) &&
((el' == el && ec' <= ec) || (el' < el))
-- | Try to find the type of the given span.
findType :: GhcMonad m
=> Map ModuleName ModInfo
-> FilePath
-> String
-> Int
-> Int
-> Int
-> Int
-> m (Either String (ModInfo, Type))
findType infos fp string sl sc el ec =
do mname <- guessModule infos fp
case mname of
Nothing ->
return (Left "Couldn't guess that module name. Does it exist?")
Just name ->
case M.lookup name infos of
Nothing ->
return (Left ("Couldn't guess the module nameIs this module loaded?"))
Just info ->
do let !mty =
resolveType (modinfoSpans info)
sl
sc
el
ec
case mty of
Just ty -> return (Right (info, ty))
Nothing ->
fmap (Right . (,) info) (exprType string)
-- | Try to resolve the type display from the given span.
resolveType :: [SpanInfo] -> Int -> Int -> Int -> Int -> Maybe Type
resolveType spans' sl sc el ec =
join (fmap spaninfoType (find inside (reverse spans')))
where inside (SpanInfo sl' sc' el' ec' _ _) =
((sl' == sl && sc' >= sc) || (sl' > sl)) &&
((el' == el && ec' <= ec) || (el' < el))
-- | Guess a module name from a file path.
guessModule :: GhcMonad m
=> Map ModuleName ModInfo -> FilePath -> m (Maybe ModuleName)
guessModule infos fp =
do target <- guessTarget fp Nothing
case targetId target of
TargetModule mn -> return (Just mn)
TargetFile fp' _ ->
case find ((Just fp' ==) .
ml_hs_file . ms_location . modinfoSummary . snd)
(M.toList infos) of
Just (mn,_) -> return (Just mn)
Nothing ->
do fp'' <- liftIO (makeRelativeToCurrentDirectory fp')
target' <- guessTarget fp'' Nothing
case targetId target' of
TargetModule mn ->
return (Just mn)
_ ->
case find ((Just fp'' ==) .
ml_hs_file . ms_location . modinfoSummary . snd)
(M.toList infos) of
Just (mn,_) ->
return (Just mn)
Nothing -> return Nothing
|
