Skip to content

Commit 14f83a6

Browse files
committed
Add an assist for OverloadedRecordDot
1 parent 6887387 commit 14f83a6

File tree

1 file changed

+31
-5
lines changed
  • plugins/hls-refactor-plugin/src/Development/IDE/Plugin

1 file changed

+31
-5
lines changed

Diff for: plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

+31-5
Original file line numberDiff line numberDiff line change
@@ -106,8 +106,8 @@ import GHC (AddEpAnn (Ad
106106
DeltaPos (..),
107107
EpAnn (..),
108108
EpaLocation (..),
109-
hsmodAnn,
110-
LEpaComment)
109+
LEpaComment,
110+
hsmodAnn)
111111
#else
112112
import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP),
113113
DeltaPos,
@@ -150,6 +150,7 @@ iePluginDescriptor recorder plId =
150150
, wrap suggestNewOrExtendImportForClassMethod
151151
, wrap suggestHideShadow
152152
, wrap suggestNewImport
153+
, wrap suggestAddRecordFieldImport
153154
]
154155
plId
155156
in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction }
@@ -1211,6 +1212,25 @@ suggestFixConstructorImport Diagnostic{_range=_range,..}
12111212
in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)]
12121213
| otherwise = []
12131214

1215+
suggestAddRecordFieldImport :: ExportsMap -> DynFlags -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
1216+
suggestAddRecordFieldImport exportsMap df ps fileContents Diagnostic {..}
1217+
| Just fieldName <- findMissingField _message
1218+
, Just (range, indent) <- newImportInsertRange ps fileContents
1219+
= let qis = qualifiedImportStyle df
1220+
suggestions = nubSortBy simpleCompareImportSuggestion (constructNewImportSuggestions exportsMap (Nothing, NotInScopeThing fieldName) Nothing qis)
1221+
in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions
1222+
| otherwise = []
1223+
where
1224+
findMissingField :: T.Text -> Maybe T.Text
1225+
findMissingField t =
1226+
let
1227+
hasfieldRegex = "((.+\\.)?HasField) \"(.+)\" ([^ ]+) ([^ ]+)"
1228+
regex = "(No instance for|Could not deduce):? (\\(" <> hasfieldRegex <> "\\)|‘" <> hasfieldRegex <> "’|" <> hasfieldRegex <> ")"
1229+
match = filter (/="") <$> matchRegexUnifySpaces t regex
1230+
in case match of
1231+
Just [_, _, _, _, fieldName, _, _] -> Just fieldName
1232+
_ -> Nothing
1233+
12141234
-- | Suggests a constraint for a declaration for which a constraint is missing.
12151235
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
12161236
suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..}
@@ -1608,10 +1628,11 @@ findPositionAfterModuleName ps hsmodName' = do
16081628
epaLocationToLine :: EpaLocation -> Maybe Int
16091629
#if MIN_VERSION_ghc(9,5,0)
16101630
epaLocationToLine (EpaSpan sp _)
1631+
= Just . srcLocLine . realSrcSpanEnd $ sp
16111632
#else
16121633
epaLocationToLine (EpaSpan sp)
1613-
#endif
16141634
= Just . srcLocLine . realSrcSpanEnd $ sp
1635+
#endif
16151636
epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
16161637
-- 'priorComments' contains the comments right before the current EpaLocation
16171638
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
@@ -1852,16 +1873,21 @@ textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCo
18521873

18531874
-- | Returns the ranges for a binding in an import declaration
18541875
rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
1855-
rangesForBindingImport ImportDecl{
18561876
#if MIN_VERSION_ghc(9,5,0)
1877+
rangesForBindingImport ImportDecl{
18571878
ideclImportList = Just (Exactly, L _ lies)
1879+
} b =
1880+
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
1881+
where
1882+
b' = wrapOperatorInParens b
18581883
#else
1884+
rangesForBindingImport ImportDecl{
18591885
ideclHiding = Just (False, L _ lies)
1860-
#endif
18611886
} b =
18621887
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
18631888
where
18641889
b' = wrapOperatorInParens b
1890+
#endif
18651891
rangesForBindingImport _ _ = []
18661892

18671893
wrapOperatorInParens :: String -> String

0 commit comments

Comments
 (0)