hls-refactor-plugin 1.1.0.0 → 1.2.0.0
raw patch · 8 files changed
+219/−67 lines, 8 filesdep ~ghcidedep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-refactor-plugin.cabal +2/−2
- src/Development/IDE/GHC/Dump.hs +4/−0
- src/Development/IDE/GHC/ExactPrint.hs +10/−3
- src/Development/IDE/Plugin/CodeAction.hs +92/−36
- src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +88/−14
- src/Development/IDE/Plugin/Plugins/AddArgument.hs +5/−5
- src/Development/IDE/Plugin/Plugins/ImportUtils.hs +14/−1
- test/Main.hs +4/−6
hls-refactor-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hls-refactor-plugin-version: 1.1.0.0+version: 1.2.0.0 synopsis: Exactprint refactorings for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -68,7 +68,7 @@ , ghc-boot , regex-tdfa , text-rope- , ghcide ^>=1.9+ , ghcide ^>=1.10 , hls-plugin-api ^>=1.6 , lsp , text
src/Development/IDE/GHC/Dump.hs view
@@ -145,7 +145,11 @@ sourceText (SourceText src) = text "SourceText" <+> text src epaAnchor :: EpaLocation -> SDoc+#if MIN_VERSION_ghc(9,5,0)+ epaAnchor (EpaSpan r _) = text "EpaSpan" <+> realSrcSpan r+#else epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r+#endif epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs anchorOp :: AnchorOperation -> SDoc
src/Development/IDE/GHC/ExactPrint.hs view
@@ -472,7 +472,7 @@ modifySmallestDeclWithM validSpan f a = do let modifyMatchingDecl [] = pure (DL.empty, Nothing) modifyMatchingDecl (ldecl@(L src _) : rest) =- lift (validSpan $ locA src) >>= \case+ TransformT (lift $ validSpan $ locA src) >>= \case True -> do (decs', r) <- f ldecl pure $ (DL.fromList decs' <> DL.fromList rest, Just r)@@ -578,11 +578,18 @@ r -> (r -> r -> m r) -> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r)+#if MIN_VERSION_ghc(9,5,0)+modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do+ (unzip -> (matches', rs)) <- mapM f matches+ r' <- TransformT $ lift $ foldM combineResults def rs+ pure $ (MG xMg (L locMatches matches'), r')+#else modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do (unzip -> (matches', rs)) <- mapM f matches r' <- lift $ foldM combineResults def rs pure $ (MG xMg (L locMatches matches') originMg, r') #endif+#endif graftSmallestDeclsWithM :: forall a.@@ -697,7 +704,7 @@ uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0)- expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered+ expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) #elif MIN_VERSION_ghc(9,2,0) expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered@@ -738,7 +745,7 @@ uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0)- expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered+ expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0 #elif MIN_VERSION_ghc(9,2,0) expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered
src/Development/IDE/Plugin/CodeAction.hs view
@@ -106,6 +106,7 @@ DeltaPos (..), EpAnn (..), EpaLocation (..),+ hsmodAnn, LEpaComment) #else import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP),@@ -240,7 +241,8 @@ extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) Nothing -> do- let n = newImport importName sym importQual False+ let qns = (,) <$> importQual <*> Just (qualifiedImportStyle df)+ n = newImport importName sym qns False sym = if isNothing importQual then Just it else Nothing it = case thingParent of Nothing -> newThing@@ -251,9 +253,21 @@ mzero isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool-isWantedModule wantedModule Nothing (L _ it@ImportDecl{ideclName, ideclHiding = Just (False, _)}) =+isWantedModule wantedModule Nothing (L _ it@ImportDecl{ ideclName+#if MIN_VERSION_ghc(9,5,0)+ , ideclImportList = Just (Exactly, _)+#else+ , ideclHiding = Just (False, _)+#endif+ }) = not (isQualifiedImport it) && unLoc ideclName == wantedModule-isWantedModule wantedModule (Just qual) (L _ ImportDecl{ideclAs, ideclName, ideclHiding = Just (False, _)}) =+isWantedModule wantedModule (Just qual) (L _ ImportDecl{ ideclAs, ideclName+#if MIN_VERSION_ghc(9,5,0)+ , ideclImportList = Just (Exactly, _)+#else+ , ideclHiding = Just (False, _)+#endif+ }) = unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False @@ -812,15 +826,21 @@ -- In the expression: seq "test" seq "test" (traceShow "test") -- In an equation for ‘f’: -- f = seq "test" seq "test" (traceShow "test")+-- | Just [ty, lit] <- matchRegexUnifySpaces _message (pat False False True False)- <|> matchRegexUnifySpaces _message (pat False False False True)- <|> matchRegexUnifySpaces _message (pat False False False False)- = codeEdit ty lit (makeAnnotatedLit ty lit)+ <|> matchRegexUnifySpaces _message (pat False False False True)+ <|> matchRegexUnifySpaces _message (pat False False False False)++ = codeEdit _range ty lit (makeAnnotatedLit ty lit) | Just source <- sourceOpt- , Just [ty, lit] <- matchRegexUnifySpaces _message (pat True True False False)- = let lit' = makeAnnotatedLit ty lit;- tir = textInRange _range source- in codeEdit ty lit (T.replace lit lit' tir)+ , Just [ty, lit, srcspan] <- matchRegexUnifySpaces _message (pat True True False False)+ , range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of+ [s] -> let x = realSrcSpanToRange s+ in x{_end = (_end x){_character = succ (_character (_end x))}}+ _ -> error "bug in srcspan parser"+ = let lit' = makeAnnotatedLit ty lit;+ tir = textInRange range source+ in codeEdit range ty lit (T.replace lit lit' tir) | otherwise = [] where makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")"@@ -828,10 +848,10 @@ pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable " , ".*to type ‘([^ ]+)’ " , "in the following constraint"- , if multiple then "s" else ""+ , if multiple then "s" else " " , ".*arising from the literal ‘(.+)’" , if inArg then ".+In the.+argument" else ""- , if at then ".+at" else ""+ , if at then ".+at ([^ ]*)" else "" , if inExpr then ".+In the expression" else "" , ".+In the expression" ]@@ -841,14 +861,14 @@ , " to type ‘([^ ]+)’ " , ".*arising from the literal ‘(.+)’" , if inArg then ".+In the.+argument" else ""- , if at then ".+at" else ""+ , if at then ".+at ([^ ]*)" else "" , if inExpr then ".+In the expression" else "" , ".+In the expression" ] #endif- codeEdit ty lit replacement =+ codeEdit range ty lit replacement = let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’"- edits = [TextEdit _range replacement]+ edits = [TextEdit range replacement] in [( title, edits )] -- | GHC strips out backticks in case of infix functions as well as single quote@@ -953,7 +973,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message- "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"+ "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)." = suggestions hsmodImports binding mod srcspan | Just (binding, mod_srcspan) <- matchRegExMultipleImports _message@@ -1118,10 +1138,17 @@ | isNothing ideclAs = Just False /= -- I don't find this particularly comprehensible, -- but HLint suggested me to do so...+#if MIN_VERSION_ghc(9,5,0)+ (ideclImportList <&> \(isHiding, L _ ents) ->+ let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents+ in (isHiding == EverythingBut) && not occurs || (isHiding == Exactly) && occurs+ )+#else (ideclHiding <&> \(isHiding, L _ ents) -> let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents in isHiding && not occurs || not isHiding && occurs )+#endif occursUnqualified _ _ = False symbolOccursIn :: T.Text -> IE GhcPs -> Bool@@ -1196,12 +1223,21 @@ where findMissingConstraint :: T.Text -> Maybe T.Text findMissingConstraint t =- let regex = "(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement- regexImplicitParams = "Could not deduce: (\\?.+) arising from a use of"+ let -- The regex below can be tested at:+ -- https://regex101.com/r/dfSivJ/1+ regex = "(No instance for|Could not deduce):? (\\((.+)\\)|‘(.+)’|.+) arising from" -- a use of / a do statement+ match = matchRegexUnifySpaces t regex- matchImplicitParams = matchRegexUnifySpaces t regexImplicitParams- in match <|> matchImplicitParams <&> last + -- For a string like:+ -- "Could not deduce: ?a::() arising from"+ -- The `matchRegexUnifySpaces` function returns two empty match+ -- groups at the end of the list. It's not clear why this is the+ -- case, so we select the last non-empty match group.+ getCorrectGroup = last . filter (/="")++ in getCorrectGroup <$> match+ -- | Suggests a constraint for an instance declaration for which a constraint is missing. suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] @@ -1417,8 +1453,8 @@ | otherwise -> [] where moduleText = moduleNameText identInfo -suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]-suggestNewImport packageExportsMap ps fileContents Diagnostic{_message}+suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]+suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg@@ -1430,16 +1466,17 @@ , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"- = let suggestions = nubSortBy simpleCompareImportSuggestion- (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions) in+ = let qis = qualifiedImportStyle df+ suggestions = nubSortBy simpleCompareImportSuggestion+ (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where L _ HsModule {..} = astA ps-suggestNewImport _ _ _ _ = []+suggestNewImport _ _ _ _ _ = [] constructNewImportSuggestions- :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [ImportSuggestion]-constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdBy simpleCompareImportSuggestion+ :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion]+constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion [ suggestion | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] -- strip away qualified module names from the unknown name , identInfo <- maybe [] Set.toList $ (lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)) <> (lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name)) -- look up the modified unknown name in the export map@@ -1451,7 +1488,7 @@ renderNewImport :: IdentInfo -> [ImportSuggestion] renderNewImport identInfo | Just q <- qual- = [ImportSuggestion importanceScore (quickFixImportKind "new.qualified") (newQualImport m q)]+ = [ImportSuggestion importanceScore (quickFixImportKind "new.qualified") (newQualImport m q qis)] | otherwise = [ImportSuggestion importanceScore (quickFixImportKind' "new" importStyle) (newUnqualImport m (renderImportStyle importStyle) False) | importStyle <- NE.toList $ importStyles identInfo] ++@@ -1555,7 +1592,11 @@ -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. whereKeywordLineOffset :: Maybe Int #if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+ whereKeywordLineOffset = case hsmodAnn hsmodExt of+#else whereKeywordLineOffset = case hsmodAnn of+#endif EpAnn _ annsModule _ -> do -- Find the first 'where' whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule@@ -1565,7 +1606,12 @@ filterWhere _ = Nothing epaLocationToLine :: EpaLocation -> Maybe Int- epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp+#if MIN_VERSION_ghc(9,5,0)+ epaLocationToLine (EpaSpan sp _)+#else+ epaLocationToLine (EpaSpan sp)+#endif+ = Just . srcLocLine . realSrcSpanEnd $ sp epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments -- 'priorComments' contains the comments right before the current EpaLocation -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and@@ -1629,10 +1675,10 @@ newImport :: T.Text -- ^ module name -> Maybe T.Text -- ^ the symbol- -> Maybe T.Text -- ^ qualified name+ -> Maybe (T.Text, QualifiedImportStyle) -- ^ qualified name and style -> Bool -- ^ the symbol is to be imported or hidden -> NewImport-newImport modName mSymbol mQual hiding = NewImport impStmt+newImport modName mSymbol mQualNameStyle hiding = NewImport impStmt where symImp | Just symbol <- mSymbol@@ -1641,15 +1687,19 @@ | otherwise = "" impStmt = "import "- <> maybe "" (const "qualified ") mQual- <> modName+ <> qualifiedModName (snd <$> mQualNameStyle) <> (if hiding then " hiding" else "") <> symImp <> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual+ mQual = fst <$> mQualNameStyle+ qualifiedModName Nothing = modName+ qualifiedModName (Just QualifiedImportPrefix) = "qualified " <> modName+ qualifiedModName (Just QualifiedImportPostfix) = modName <> " qualified" -newQualImport :: T.Text -> T.Text -> NewImport-newQualImport modName qual = newImport modName Nothing (Just qual) False +newQualImport :: T.Text -> T.Text -> QualifiedImportStyle -> NewImport+newQualImport modName qual qis = newImport modName Nothing (Just (qual, qis)) False+ newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport newUnqualImport modName symbol = newImport modName (Just symbol) Nothing @@ -1802,7 +1852,13 @@ -- | Returns the ranges for a binding in an import declaration rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]-rangesForBindingImport ImportDecl{ideclHiding = Just (False, L _ lies)} b =+rangesForBindingImport ImportDecl{+#if MIN_VERSION_ghc(9,5,0)+ ideclImportList = Just (Exactly, L _ lies)+#else+ ideclHiding = Just (False, L _ lies)+#endif+ } b = concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies where b' = wrapOperatorInParens b
src/Development/IDE/Plugin/CodeAction/ExactPrint.hs view
@@ -311,7 +311,7 @@ #else Right x -> pure (makeDeltaAst x) #endif- Left _ -> lift $ Left $ "No parse: " <> s+ Left _ -> TransformT $ lift $ Left $ "No parse: " <> s #if !MIN_VERSION_ghc(9,2,0) lookupAnn :: (Data a, Monad m)@@ -344,7 +344,7 @@ liftMaybe :: String -> Maybe a -> TransformT (Either String) a liftMaybe _ (Just x) = return x-liftMaybe s _ = lift $ Left s+liftMaybe s _ = TransformT $ lift $ Left s ------------------------------------------------------------------------------ extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite@@ -376,7 +376,11 @@ LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportTopLevel thing (L l it@ImportDecl{..})+#if MIN_VERSION_ghc(9,5,0)+ | Just (hide, L l' lies) <- ideclImportList+#else | Just (hide, L l' lies) <- ideclHiding+#endif , hasSibling <- not $ null lies = do src <- uniqueSrcSpanT top <- uniqueSrcSpanT@@ -385,13 +389,17 @@ printOutputable (occName (unLoc rdr)) `elem` map (printOutputable @OccName) (listify (const True) lies) when alreadyImported $- lift (Left $ thing <> " already imported")+ TransformT $ lift (Left $ thing <> " already imported") - let lie = reLocA $ L src $ IEName rdr+ let lie = reLocA $ L src $ IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField+#endif+ rdr x = reLocA $ L top $ IEVar noExtField lie if x `elem` lies- then lift (Left $ thing <> " already imported")+ then TransformT $ lift (Left $ thing <> " already imported") else do #if !MIN_VERSION_ghc(9,2,0) anns <- getAnnsT@@ -416,9 +424,13 @@ return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} #else let lies' = addCommaInImportList lies x+#if MIN_VERSION_ghc(9,5,0)+ return $ L l it{ideclImportList = Just (hide, L l' lies')}+#else return $ L l it{ideclHiding = Just (hide, L l' lies')} #endif-extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"+#endif+extendImportTopLevel _ _ = TransformT $ lift $ Left "Unable to extend the import list" wildCardSymbol :: String wildCardSymbol = ".."@@ -447,16 +459,24 @@ LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportViaParent df parent child (L l it@ImportDecl{..})+#if MIN_VERSION_ghc(9,5,0)+ | Just (hide, L l' lies) <- ideclImportList = go hide l' [] lies+#else | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies+#endif where go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs)- | parent == unIEWrappedName ie = lift . Left $ child <> " already included in " <> parent <> " imports"+ | parent == unIEWrappedName ie = TransformT $ lift . Left $ child <> " already included in " <> parent <> " imports" go hide l' pre (lAbs@(L ll' (IEThingAbs _ absIE@(L _ ie))) : xs) -- ThingAbs ie => ThingWith ie child | parent == unIEWrappedName ie = do srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child- childLIE = reLocA $ L srcChild $ IEName childRdr+ childLIE = reLocA $ L srcChild $ IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField+#endif+ childRdr #if !MIN_VERSION_ghc(9,2,0) x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] [] -- take anns from ThingAbs, and attach parens to it@@ -465,7 +485,13 @@ #else x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE] #endif++#if MIN_VERSION_ghc(9,5,0)+ return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)}+#else return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)}+#endif+ #if !MIN_VERSION_ghc(9,2,0) go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs) #else@@ -475,7 +501,11 @@ | parent == unIEWrappedName ie , child == wildCardSymbol = do #if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+ let it' = it{ideclImportList = Just (hide, lies)}+#else let it' = it{ideclHiding = Just (hide, lies)}+#endif thing = IEThingWith newl twIE (IEWildcard 2) [] newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' lies = L l' $ reverse pre ++ [L l'' thing] ++ xs@@ -497,16 +527,24 @@ printOutputable (occName (unLoc childRdr)) `elem` map (printOutputable @OccName) (listify (const True) lies') when alreadyImported $- lift (Left $ child <> " already included in " <> parent <> " imports")+ TransformT $ lift (Left $ child <> " already included in " <> parent <> " imports") - let childLIE = reLocA $ L srcChild $ IEName childRdr+ let childLIE = reLocA $ L srcChild $ IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField+#endif+ childRdr #if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (last lies') addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} #else+#if MIN_VERSION_ghc(9,5,0)+ let it' = it{ideclImportList = Just (hide, lies)}+#else let it' = it{ideclHiding = Just (hide, lies)}+#endif lies = L l' $ reverse pre ++ [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs fixLast = if hasSibling then first addComma else id@@ -528,12 +566,21 @@ let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr) childLIE = reLocA $ L srcChild $ IEName childRdr #else- let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr')+ let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr'+ else IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField+#endif+ parentRdr') parentRdr' = modifyAnns parentRdr $ \case it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1, nann_close = epl 0} other -> other- childLIE = reLocA $ L srcChild $ IEName childRdr+ childLIE = reLocA $ L srcChild $ IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField #endif+ childRdr+#endif #if !MIN_VERSION_ghc(9,2,0) x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] -- Add AnnType for the parent if it's parenthesized (type operator)@@ -554,8 +601,12 @@ lies' = addCommaInImportList (reverse pre) x #endif+#if MIN_VERSION_ghc(9,5,0)+ return $ L l it{ideclImportList = Just (hide, L l' lies')}+#else return $ L l it{ideclHiding = Just (hide, L l' lies')}-extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent"+#endif+extendImportViaParent _ _ _ _ = TransformT $ lift $ Left "Unable to extend the import list via parent" #if MIN_VERSION_ghc(9,2,0) -- Add an item in an import list, taking care of adding comma if needed.@@ -592,7 +643,11 @@ fixLast = over _last (first (if existingTrailingComma then id else addComma)) #endif +#if MIN_VERSION_ghc(9,5,0)+unIEWrappedName :: IEWrappedName GhcPs -> String+#else unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String+#endif unIEWrappedName (occName -> occ) = T.unpack $ printOutputable $ parenSymOcc occ (ppr occ) hasParen :: String -> Bool@@ -615,10 +670,17 @@ hideSymbol :: String -> LImportDecl GhcPs -> Rewrite hideSymbol symbol lidecl@(L loc ImportDecl{..}) =+#if MIN_VERSION_ghc(9,5,0)+ case ideclImportList of+ Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing+ Just (EverythingBut, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides)+ Just (Exactly, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports+#else case ideclHiding of Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports+#endif hideSymbol _ (L _ (XImportDecl _)) = error "cannot happen" @@ -655,7 +717,11 @@ #if MIN_VERSION_ghc(9,2,0) rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr) #endif- let lie = reLocA $ L src $ IEName rdr+ let lie = reLocA $ L src $ IEName+#if MIN_VERSION_ghc(9,5,0)+ noExtField+#endif+ rdr x = reLocA $ L top $ IEVar noExtField lie #if MIN_VERSION_ghc(9,2,0) x <- pure $ if hasSibling then first addComma x else x@@ -682,7 +748,11 @@ else forM_ mlies $ \lies0 -> do transferAnn lies0 singleHide id #endif+#if MIN_VERSION_ghc(9,5,0)+ return $ L l idecls{ideclImportList = Just (EverythingBut, L l' $ x : lies)}+#else return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)}+#endif where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc @@ -701,7 +771,11 @@ lidecl' = L l $ idecl+#if MIN_VERSION_ghc(9,5,0)+ { ideclImportList = Just (Exactly, edited)+#else { ideclHiding = Just (False, edited)+#endif } #if !MIN_VERSION_ghc(9,2,0) -- avoid import A (foo,)
src/Development/IDE/Plugin/Plugins/AddArgument.hs view
@@ -10,7 +10,7 @@ import Language.LSP.Types #else import Control.Monad (join)-import Control.Monad.Except (lift)+import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T@@ -34,7 +34,7 @@ import GHC.Types.SrcLoc (generatedSrcSpan) import Ide.PluginUtils (makeDiffTextEdit, responseError)-import Language.Haskell.GHC.ExactPrint (TransformT,+import Language.Haskell.GHC.ExactPrint (TransformT(..), noAnnSrcSpanDP1, runTransformT) import Language.Haskell.GHC.ExactPrint.Transform (d1)@@ -85,10 +85,10 @@ -- => (`foo bar baz new_pat = 1`, Just ("foo", 2)) appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either ResponseError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int)) appendFinalPatToMatches name = \case- (L locDecl (ValD xVal (FunBind xFunBind idFunBind mg coreFunBind))) -> do+ (L locDecl (ValD xVal fun@FunBind{fun_matches=mg,fun_id = idFunBind})) -> do (mg', numPatsMay) <- modifyMgMatchesT' mg (pure . second Just . addArgToMatch name) Nothing combineMatchNumPats- numPats <- lift $ maybeToEither (responseError "Unexpected empty match group in HsDecl") numPatsMay- let decl' = L locDecl (ValD xVal (FunBind xFunBind idFunBind mg' coreFunBind))+ numPats <- TransformT $ lift $ maybeToEither (responseError "Unexpected empty match group in HsDecl") numPatsMay+ let decl' = L locDecl (ValD xVal fun{fun_matches=mg'}) pure (decl', Just (idFunBind, numPats)) decl -> pure (decl, Nothing) where
src/Development/IDE/Plugin/Plugins/ImportUtils.hs view
@@ -4,11 +4,14 @@ quickFixImportKind, renderImportStyle, unImportStyle,- importStyles+ importStyles,+ QualifiedImportStyle(..),+ qualifiedImportStyle ) where import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Text as T+import Development.IDE.GHC.Compat import Development.IDE.Plugin.CodeAction.ExactPrint (wildCardSymbol) import Development.IDE.Types.Exports import Language.LSP.Types (CodeActionKind (..))@@ -83,3 +86,13 @@ quickFixImportKind :: T.Text -> CodeActionKind quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x++-- | Possible import styles for qualified imports+data QualifiedImportStyle = QualifiedImportPostfix | QualifiedImportPrefix+ deriving Show++qualifiedImportStyle :: DynFlags -> QualifiedImportStyle+qualifiedImportStyle df | hasImportQualifedPostEnabled && hasPrePositiveQualifiedWarning = QualifiedImportPostfix+ | otherwise = QualifiedImportPrefix+ where hasImportQualifedPostEnabled = xopt ImportQualifiedPost df+ hasPrePositiveQualifiedWarning = wopt Opt_WarnPrepositiveQualifiedModule df
test/Main.hs view
@@ -64,11 +64,11 @@ main :: IO () main = defaultTestRunner tests -refactorPlugin :: IO [PluginDescriptor IdeState]+refactorPlugin :: IO (IdePlugins IdeState) refactorPlugin = do exactprintLog <- pluginTestRecorder ghcideLog <- pluginTestRecorder- pure $+ pure $ IdePlugins $ [ Refactor.iePluginDescriptor exactprintLog "ghcide-code-actions-imports-exports" , Refactor.typeSigsPluginDescriptor exactprintLog "ghcide-code-actions-type-signatures" , Refactor.bindingsPluginDescriptor exactprintLog "ghcide-code-actions-bindings"@@ -2416,8 +2416,7 @@ , "" , "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\"" ])- , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $- testSession "add default type to satisfy two constraints" $+ , testSession "add default type to satisfy two constraints" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}"@@ -2441,8 +2440,7 @@ , "" , "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a" ])- , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $- testSession "add default type to satisfy two constraints with duplicate literals" $+ , testSession "add default type to satisfy two constraints with duplicate literals" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}"