Skip to content

Commit 40f9ae4

Browse files
wczyzwczyz
committed
Display inlay hint after import/import qualified
1 parent 0d56127 commit 40f9ae4

File tree

1 file changed

+53
-80
lines changed

1 file changed

+53
-80
lines changed

‎plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

Lines changed: 53 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,8 @@ module Ide.Plugin.ExplicitImports
1616
) where
1717

1818
import Control.DeepSeq
19-
import Control.Lens (_Just, (&), (?~), (^?))
20-
import Control.Monad (guard)
19+
import Control.Lens (_Just, (&), (?~), (^.),
20+
(^?))
2121
import Control.Monad.Error.Class (MonadError (throwError))
2222
import Control.Monad.IO.Class
2323
import Control.Monad.Trans.Class (lift)
@@ -26,16 +26,14 @@ import Control.Monad.Trans.Maybe
2626
import qualified Data.Aeson as A (ToJSON (toJSON))
2727
import Data.Aeson.Types (FromJSON)
2828
import Data.Char (isSpace)
29-
import Data.Either (lefts)
3029
import Data.Functor ((<&>))
3130
import qualified Data.IntMap as IM (IntMap, elems,
3231
fromList, (!?))
3332
import Data.IORef (readIORef)
34-
import Data.List (singleton, sortBy)
35-
import Data.List.NonEmpty (groupBy, head)
33+
import Data.List (singleton)
3634
import qualified Data.Map.Strict as Map
37-
import Data.Maybe (isJust, isNothing,
38-
listToMaybe, mapMaybe)
35+
import Data.Maybe (catMaybes, isJust,
36+
isNothing, mapMaybe)
3937
import qualified Data.Set as S
4038
import Data.String (fromString)
4139
import qualified Data.Text as T
@@ -49,11 +47,9 @@ import Development.IDE.Core.PluginUtils
4947
import Development.IDE.Core.PositionMapping
5048
import qualified Development.IDE.Core.Shake as Shake
5149
import Development.IDE.GHC.Compat hiding ((<+>))
52-
import Development.IDE.GHC.Compat.Util (mkFastString)
5350
import Development.IDE.Graph.Classes
5451
import GHC.Generics (Generic)
55-
import GHC.Num (integerFromInt)
56-
import GHC.Parser.Annotation (EpAnn (entry),
52+
import GHC.Parser.Annotation (EpAnn (anns),
5753
HasLoc (getHasLoc),
5854
realSrcSpan)
5955
import GHC.Types.PkgQual (RawPkgQual (NoRawPkgQual))
@@ -251,89 +247,66 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo
251247
then do
252248
nfp <- getNormalizedFilePathE _uri
253249
(hscEnvEq, _) <- runActionE "ImportPackageInlayHint.GhcSessionDeps" state $ useWithStaleE GhcSessionDeps nfp
254-
(HAR {hieAst, hieModule}, pmap) <- runActionE "ImportPackageInlayHint.GetHieAst" state $ useWithStaleE GetHieAst nfp
255-
ast <- handleMaybe
256-
(PluginRuleFailed "GetHieAst")
257-
(getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp)
258-
parsedModule <- runActionE "GADT.GetParsedModuleWithComments" state $ useE GetParsedModule nfp
259-
let (L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule
250+
(parsedModule, pmap) <- runActionE "ImportPackageInlayHint.GetParsedModuleWithComments" state $ useWithStaleE GetParsedModule nfp
260251

261-
let isPackageImport :: ImportDecl GhcPs -> Bool
262-
isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False
263-
isPackageImport _ = True
252+
let moduleNamePositions = getModuleNamePositions parsedModule
253+
env = hscEnv hscEnvEq
254+
255+
packagePositions <- fmap catMaybes $ for moduleNamePositions $ \(pos, moduleName) -> do
256+
packageName <- liftIO $ packageNameForModuleName moduleName env
257+
case packageName of
258+
Nothing -> pure Nothing
259+
Just packageName -> pure $ Just (pos, packageName)
264260

265-
annotationToLineNumber :: EpAnn a -> Integer
266-
annotationToLineNumber = integerFromInt . srcSpanEndLine . realSrcSpan . getHasLoc . entry
267-
268-
packageImportLineNumbers :: S.Set Integer
269-
packageImportLineNumbers =
270-
S.fromList $
271-
hsImports
272-
& filter (\(L _ importDecl) -> isPackageImport importDecl)
273-
& map (\(L annotation _) -> annotationToLineNumber annotation)
274-
275-
hintsInfo <- liftIO $ getAllImportedPackagesHints (hscEnv hscEnvEq) (moduleName hieModule) ast
276-
-- Sort the hints by position and group them by line
277-
-- Show only first hint in each line
278-
let selectedHintsInfo = hintsInfo
279-
& sortBy (\(Range (Position l1 c1) _, _) (Range (Position l2 c2) _, _) ->
280-
compare l1 l2 <> compare c1 c2)
281-
& groupBy (\(Range (Position l1 _) _, _) (Range (Position l2 _) _, _) -> l1 == l2)
282-
& map Data.List.NonEmpty.head
283-
-- adding 1 because RealSrcLoc begins with 1
284-
& filter (\(Range (Position l _) _, _) -> S.notMember (toInteger l + 1) packageImportLineNumbers)
285-
let inlayHints = [ generateInlayHint newRange txt
286-
| (range, txt) <- selectedHintsInfo
287-
, Just newRange <- [toCurrentRange pmap range]
288-
, isSubrangeOf newRange visibleRange]
261+
let inlayHints = [ generateInlayHint newPos txt
262+
| (pos, txt) <- packagePositions
263+
, Just newPos <- [toCurrentPosition pmap pos]
264+
, positionInRange newPos visibleRange]
289265
pure $ InL inlayHints
290266
-- When the client does not support inlay hints, do not display anything
291267
else pure $ InL []
292268
where
293-
generateInlayHint :: Range -> T.Text -> InlayHint
294-
generateInlayHint (Range start _) txt =
295-
InlayHint { _position = start
269+
generateInlayHint :: Position -> T.Text -> InlayHint
270+
generateInlayHint pos txt =
271+
InlayHint { _position = pos
296272
, _label = InL txt
297273
, _kind = Nothing
298274
, _textEdits = Nothing
299275
, _tooltip = Nothing
300-
, _paddingLeft = Nothing
301-
, _paddingRight = Just True
276+
, _paddingLeft = Just True
277+
, _paddingRight = Nothing
302278
, _data_ = Nothing
303279
}
304280

305-
-- | Get inlay hints information for all imported packages
306-
getAllImportedPackagesHints :: HscEnv -> ModuleName -> HieAST a -> IO [(Range, T.Text)]
307-
getAllImportedPackagesHints env currentModuleName = go
308-
where
309-
go :: HieAST a -> IO [(Range, T.Text)]
310-
go ast = do
311-
let range = realSrcSpanToRange $ nodeSpan ast
312-
childrenResults <- traverse go (nodeChildren ast)
313-
mbPackage <- getImportedPackage ast
314-
return $ case mbPackage of
315-
Nothing -> mconcat childrenResults
316-
Just package -> (range, package) : mconcat childrenResults
317-
318-
getImportedPackage :: HieAST a -> IO (Maybe T.Text)
319-
getImportedPackage ast = runMaybeT $ do
320-
nodeInfo <- MaybeT $ return $ sourceNodeInfo ast
321-
moduleName <- MaybeT $ return $
322-
nodeIdentifiers nodeInfo
323-
& Map.keys
324-
& lefts
325-
& listToMaybe
326-
filteredModuleName <- MaybeT $ return $
327-
guard (moduleName /= currentModuleName) >> Just moduleName
328-
txt <- MaybeT $ packageNameForModuleName filteredModuleName
329-
return $ "\"" <> txt <> "\""
330-
331-
packageNameForModuleName :: ModuleName -> IO (Maybe T.Text)
332-
packageNameForModuleName modName = runMaybeT $ do
333-
mod <- MaybeT $ findImportedModule env modName
334-
let pid = moduleUnit mod
335-
conf <- MaybeT $ return $ lookupUnit env pid
336-
return $ T.pack $ unitPackageNameString conf
281+
packageNameForModuleName :: ModuleName -> HscEnv -> IO (Maybe T.Text)
282+
packageNameForModuleName modName env = runMaybeT $ do
283+
mod <- MaybeT $ findImportedModule env modName
284+
let pid = moduleUnit mod
285+
conf <- MaybeT $ return $ lookupUnit env pid
286+
let packageName = T.pack $ unitPackageNameString conf
287+
return $ "\"" <> packageName <> "\""
288+
289+
getModuleNamePositions :: ParsedModule -> [(Position, ModuleName)]
290+
getModuleNamePositions parsedModule =
291+
let isPackageImport :: ImportDecl GhcPs -> Bool
292+
isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False
293+
isPackageImport _ = True
294+
295+
(L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule
296+
297+
srcSpanToPosition :: SrcSpan -> Position
298+
srcSpanToPosition srcSpan = (realSrcSpanToRange . realSrcSpan $ srcSpan) ^. L.end
299+
300+
annToPosition :: EpAnnImportDecl -> Position
301+
annToPosition ann = case importDeclAnnQualified ann of
302+
Just loc -> (srcSpanToPosition $ getHasLoc loc)
303+
_ -> (srcSpanToPosition $ getHasLoc $ importDeclAnnImport ann)
304+
305+
in hsImports
306+
& filter (\(L _ importDecl) -> not $ isPackageImport importDecl)
307+
& map (\(L _ importDecl) ->
308+
(annToPosition $ anns $ ideclAnn $ ideclExt importDecl, unLoc $ ideclName importDecl))
309+
337310

338311

339312
-- |For explicit imports: If there are any implicit imports, provide both one

0 commit comments

Comments
 (0)