Fix misplaced inlay hints by applying PositionMapping

Author: jetjinser

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

@@ -218,16 +218,18 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif
     --                  |^-_paddingLeft
     --                  ^-_position
     generateInlayHints :: Range -> ImportEdit -> PositionMapping -> Maybe InlayHint
-    generateInlayHints (Range _ end) ie pm = mkLabel ie <&> \label ->
-      InlayHint { _position = end
-                , _label = InL label
-                , _kind = Nothing -- neither a type nor a parameter
-                , _textEdits = fmap singleton $ toTEdit pm ie
-                , _tooltip = Just $ InL "Make this import explicit" -- simple enough, no need to resolve
-                , _paddingLeft = Just True -- show an extra space before the inlay hint
-                , _paddingRight = Nothing
-                , _data_ = Nothing
-                }
+    generateInlayHints (Range _ end) ie pm = do
+      label <- mkLabel ie
+      currentEnd <- toCurrentPosition pm end
+      return InlayHint { _position = currentEnd
+                       , _label = InL label
+                       , _kind = Nothing -- neither a type nor a parameter
+                       , _textEdits = fmap singleton $ toTEdit pm ie
+                       , _tooltip = Just $ InL "Make this import explicit" -- simple enough, no need to resolve
+                       , _paddingLeft = Just True -- show an extra space before the inlay hint
+                       , _paddingRight = Nothing
+                       , _data_ = Nothing
+                       }
     mkLabel :: ImportEdit -> Maybe T.Text
     mkLabel (ImportEdit{ieResType, ieText}) =
       let title ExplicitImport = Just $ abbreviateImportTitleWithoutModule ieText

plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs

@@ -43,7 +43,8 @@ import           Development.IDE                      (IdeState,
                                                        srcSpanToLocation,
                                                        srcSpanToRange, viaShow)
 import           Development.IDE.Core.PluginUtils
-import           Development.IDE.Core.PositionMapping (toCurrentRange)
+import           Development.IDE.Core.PositionMapping (toCurrentPosition,
+                                                       toCurrentRange)
 import           Development.IDE.Core.RuleTypes       (TcModuleResult (..),
                                                        TypeCheck (..))
 import qualified Development.IDE.Core.Shake           as Shake
@@ -204,19 +205,19 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen
                     | record <- records
                     , pos <- maybeToList $ fmap _start $ recordInfoToDotDotRange record ]
     defnLocsList <- lift $ sequence locations
-    pure $ InL $ mapMaybe (mkInlayHint crr pragma) defnLocsList
+    pure $ InL $ mapMaybe (mkInlayHint crr pragma pm) defnLocsList
    where
-     mkInlayHint :: CollectRecordsResult -> NextPragmaInfo -> (Maybe [(Location, Identifier)], RecordInfo) -> Maybe InlayHint
-     mkInlayHint CRR {enabledExtensions, nameMap} pragma (defnLocs, record) =
+     mkInlayHint :: CollectRecordsResult -> NextPragmaInfo -> PositionMapping -> (Maybe [(Location, Identifier)], RecordInfo) -> Maybe InlayHint
+     mkInlayHint CRR {enabledExtensions, nameMap} pragma pm (defnLocs, record) =
        let range = recordInfoToDotDotRange record
            textEdits = maybeToList (renderRecordInfoAsTextEdit nameMap record)
                     <> maybeToList (pragmaEdit enabledExtensions pragma)
            names = renderRecordInfoAsDotdotLabelName record
        in do
-         end <- fmap _end range
+         currentEnd <- range >>= toCurrentPosition pm . _end
          names' <- names
          defnLocs' <- defnLocs
-         let excludeDotDot (Location _ (Range _ end')) = end' /= end
+         let excludeDotDot (Location _ (Range _ end)) = end /= currentEnd
              -- find location from dotdot definitions that name equal to label name
              findLocation name locations =
                let -- filter locations not within dotdot range
@@ -227,7 +228,7 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen
              valueWithLoc = [ (T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
              -- use `, ` to separate labels with definition location
              label = intersperse (mkInlayHintLabelPart (", ", Nothing)) $ fmap mkInlayHintLabelPart valueWithLoc
-         pure $ InlayHint { _position = end -- at the end of dotdot
+         pure $ InlayHint { _position = currentEnd -- at the end of dotdot
                           , _label = InR label
                           , _kind = Nothing -- neither a type nor a parameter
                           , _textEdits = Just textEdits -- same as CodeAction
@@ -319,11 +320,11 @@ collectNamesRule = defineNoDiagnostics mempty $ \CollectNames nfp -> runMaybeT $
 -- | Collects all 'Name's of a given source file, to be used
 -- in the variable usage analysis.
 getNames :: TcModuleResult -> UniqFM Name [Name]
-#if __GLASGOW_HASKELL__ < 910
+
 getNames (tmrRenamed -> (group,_,_,_))   = collectNames group
-#else
-getNames (tmrRenamed -> (group,_,_,_,_)) = collectNames group
-#endif
+
+
+
 
 data CollectRecords = CollectRecords
                     deriving (Eq, Show, Generic)
@@ -506,11 +507,11 @@ showRecordPatFlds (ConPat _ _ args) = do
   where
     processRecCon (RecCon flds) = Just $ processRecordFlds flds
     processRecCon _             = Nothing
-#if __GLASGOW_HASKELL__ < 911
+
     getOccName (FieldOcc x _) = Just $ getName x
-#else
-    getOccName (FieldOcc _ x) = Just $ getName (unLoc x)
-#endif
+
+
+
     getOccName _              = Nothing
     getFieldName = getOccName . unLoc . hfbLHS . unLoc
 showRecordPatFlds _ = Nothing
@@ -561,11 +562,11 @@ getRecCons :: LHsExpr GhcTc -> ([RecordInfo], Bool)
 -- because there is a possibility that there were be more than one result per
 -- branch
 
-#if __GLASGOW_HASKELL__ >= 910
-getRecCons (unLoc -> XExpr (ExpandedThingTc a _)) = (collectRecords a, False)
-#else
+
+
+
 getRecCons (unLoc -> XExpr (ExpansionExpr (HsExpanded _ a))) = (collectRecords a, True)
-#endif
+
 getRecCons e@(unLoc -> RecordCon _ _ flds)
   | isJust (rec_dotdot flds) = (mkRecInfo e, False)
   where
@@ -593,11 +594,11 @@ getRecCons expr@(unLoc -> app@(HsApp _ _ _)) =
 
     getExprFields :: HsExpr GhcTc -> [FieldLabel]
     getExprFields (XExpr (ConLikeTc (conLikeFieldLabels -> fls) _ _)) = fls
-#if __GLASGOW_HASKELL__ >= 911
-    getExprFields (XExpr (WrapExpr _ expr)) = getExprFields expr
-#else
+
+
+
     getExprFields (XExpr (WrapExpr (HsWrap _ expr))) = getExprFields expr
-#endif
+
     getExprFields _ = []
 getRecCons _ = ([], False)