hls-refactor-plugin 2.4.0.0 → 2.5.0.0
raw patch · 12 files changed
+33/−604 lines, 12 filesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utils
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
Files
- hls-refactor-plugin.cabal +4/−4
- src/Development/IDE/GHC/Compat/ExactPrint.hs +0/−16
- src/Development/IDE/GHC/Dump.hs +3/−19
- src/Development/IDE/GHC/ExactPrint.hs +3/−96
- src/Development/IDE/Plugin/CodeAction.hs +9/−98
- src/Development/IDE/Plugin/CodeAction/Args.hs +0/−5
- src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +2/−286
- src/Development/IDE/Plugin/CodeAction/Util.hs +1/−13
- src/Development/IDE/Plugin/Plugins/AddArgument.hs +0/−10
- test/Main.hs +7/−48
- test/Test/AddArgument.hs +4/−6
- test/data/hover/RecordDotSyntax.hs +0/−3
hls-refactor-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hls-refactor-plugin-version: 2.4.0.0+version: 2.5.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>@@ -73,8 +73,8 @@ , ghc-boot , regex-tdfa , text-rope- , ghcide == 2.4.0.0- , hls-plugin-api == 2.4.0.0+ , ghcide == 2.5.0.0+ , hls-plugin-api == 2.5.0.0 , lsp , text , transformers@@ -112,7 +112,7 @@ , base , filepath , hls-refactor-plugin- , hls-test-utils == 2.4.0.0+ , hls-test-utils == 2.5.0.0 , lens , lsp-types , text
src/Development/IDE/GHC/Compat/ExactPrint.hs view
@@ -8,26 +8,10 @@ , Retrie.Annotated, pattern Annotated, astA, annsA ) where -#if !MIN_VERSION_ghc(9,2,0)-import Control.Arrow ((&&&))-#else import Development.IDE.GHC.Compat.Parser-#endif import Language.Haskell.GHC.ExactPrint as Retrie import qualified Retrie.ExactPrint as Retrie -#if !MIN_VERSION_ghc(9,2,0)-class ExactPrint ast where- makeDeltaAst :: ast -> ast- makeDeltaAst = id -instance ExactPrint ast-#endif--#if !MIN_VERSION_ghc(9,2,0)-pattern Annotated :: ast -> Anns -> Retrie.Annotated ast-pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA))-#else pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA))-#endif
src/Development/IDE/GHC/Dump.hs view
@@ -1,40 +1,26 @@ {-# LANGUAGE CPP #-} module Development.IDE.GHC.Dump(showAstDataHtml) where+import qualified Data.ByteString as B import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (LocatedA, NameAnn) import Development.IDE.GHC.Compat.ExactPrint-import GHC.Hs.Dump-#if MIN_VERSION_ghc(9,2,1)-import qualified Data.ByteString as B import Development.IDE.GHC.Compat.Util import Generics.SYB (ext1Q, ext2Q, extQ) import GHC.Hs hiding (AnnLet)-#endif+import GHC.Hs.Dump import GHC.Plugins hiding (AnnLet) import Prelude hiding ((<>)) -- | Show a GHC syntax tree in HTML.-#if MIN_VERSION_ghc(9,2,1) showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc-#else-showAstDataHtml :: (Data a, Outputable a) => a -> SDoc-#endif showAstDataHtml a0 = html $ header $$ body (tag' [("id",text (show @String "myUL"))] "ul" $ vcat [-#if MIN_VERSION_ghc(9,2,1) li (pre $ text (exactPrint a0)), li (showAstDataHtml' a0), li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0)-#else- li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan-#if MIN_VERSION_ghc(9,3,0)- NoBlankEpAnnotations-#endif- a0)-#endif ]) where tag = tag' []@@ -46,7 +32,7 @@ li = tag "li" caret x = tag' [("class", text "caret")] "span" "" <+> x nested foo cts-#if MIN_VERSION_ghc(9,2,1) && !MIN_VERSION_ghc(9,3,0)+#if !MIN_VERSION_ghc(9,3,0) | cts == empty = foo #endif | otherwise = foo $$ (caret $ ul cts)@@ -54,7 +40,6 @@ header = tag "head" $ tag "style" $ text css html = tag "html" pre = tag "pre"-#if MIN_VERSION_ghc(9,2,1) showAstDataHtml' :: Data a => a -> SDoc showAstDataHtml' = (generic@@ -287,7 +272,6 @@ $$ li(srcSpan s)) Nothing -> text "locatedAnn:unmatched" <+> tag <+> (text (showConstr (toConstr ss)))-#endif normalize_newlines :: String -> String
src/Development/IDE/GHC/ExactPrint.hs view
@@ -17,18 +17,11 @@ transform, transformM, ExactPrint(..),-#if MIN_VERSION_ghc(9,2,1) modifySmallestDeclWithM, modifyMgMatchesT, modifyMgMatchesT', modifySigWithM, genAnchor1,-#endif-#if !MIN_VERSION_ghc(9,2,0)- Anns,- Annotate,- setPrecedingLinesT,-#else setPrecedingLines, addParens, addParensToCtxt,@@ -39,7 +32,6 @@ epl, epAnn, removeTrailingComma,-#endif annotateParsedSource, getAnnotatedParsedSourceRule, GetAnnotatedParsedSource(..),@@ -98,7 +90,7 @@ #if MIN_VERSION_ghc(9,9,0) import GHC.Plugins (showSDoc) import GHC.Utils.Outputable (Outputable (ppr))-#elif MIN_VERSION_ghc(9,2,0)+#else import GHC (EpAnn (..), NameAdornment (NameParens), NameAnn (..),@@ -113,18 +105,14 @@ deltaPos) #endif -#if MIN_VERSION_ghc(9,2,1) import Data.List (partition) import GHC (Anchor(..), realSrcSpan, AnchorOperation, DeltaPos(..), SrcSpanAnnN) import GHC.Types.SrcLoc (generatedSrcSpan) import Control.Lens ((&), _last) import Control.Lens.Operators ((%~))-#endif -#if MIN_VERSION_ghc(9,2,0) setPrecedingLines :: Default t => LocatedAn t a -> Int -> Int -> LocatedAn t a setPrecedingLines ast n c = setEntryDP ast (deltaPos n c)-#endif ------------------------------------------------------------------------------ data Log = LogShake Shake.Log deriving Show@@ -152,13 +140,8 @@ pm <- use GetParsedModuleWithComments nfp return ([], fmap annotateParsedSource pm) -#if MIN_VERSION_ghc(9,2,0) annotateParsedSource :: ParsedModule -> Annotated ParsedSource annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0-#else-annotateParsedSource :: ParsedModule -> Annotated ParsedSource-annotateParsedSource = fixAnns-#endif ------------------------------------------------------------------------------ @@ -287,12 +270,7 @@ LocatedAn l ast -> Graft (Either String) a graft' needs_space dst val = Graft $ \dflags a -> do-#if MIN_VERSION_ghc(9,2,0) val' <- annotate dflags needs_space val-#else- (anns, val') <- annotate dflags needs_space val- modifyAnnsT $ mappend anns-#endif pure $ everywhere' ( mkT $@@ -360,18 +338,10 @@ mval <- trans val case mval of Just val' -> do-#if MIN_VERSION_ghc(9,2,0) val'' <- hoistTransform (either Fail.fail pure) (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val')) pure val''-#else- (anns, val'') <-- hoistTransform (either Fail.fail pure)- (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))- modifyAnnsT $ mappend anns- pure val''-#endif Nothing -> pure val l -> pure l )@@ -392,18 +362,10 @@ mval <- trans val case mval of Just val' -> do-#if MIN_VERSION_ghc(9,2,0) val'' <- hoistTransform (either Fail.fail pure) $ annotate dflags False $ maybeParensAST val' pure val''-#else- (anns, val'') <-- hoistTransform (either Fail.fail pure) $- annotate dflags True $ maybeParensAST val'- modifyAnnsT $ mappend anns- pure val''-#endif Nothing -> pure val l -> pure l )@@ -451,7 +413,6 @@ | otherwise = DL.singleton (L src e) <> go rest modifyDeclsT (pure . DL.toList . go) a -#if MIN_VERSION_ghc(9,2,1) -- | Replace the smallest declaration whose SrcSpan satisfies the given condition with a new -- list of declarations.@@ -588,7 +549,6 @@ r' <- lift $ foldM combineResults def rs pure $ (MG xMg (L locMatches matches') originMg, r') #endif-#endif graftSmallestDeclsWithM :: forall a.@@ -635,9 +595,7 @@ , Typeable l , Outputable l , Outputable ast-#if MIN_VERSION_ghc(9,2,0) , Default l-#endif ) => ASTElement l ast | ast -> l where parseAST :: Parser (LocatedAn l ast) maybeParensAST :: LocatedAn l ast -> LocatedAn l ast@@ -680,13 +638,6 @@ ------------------------------------------------------------------------------ -#if !MIN_VERSION_ghc(9,2,0)--- | Dark magic I stole from retrie. No idea what it does.-fixAnns :: ParsedModule -> Annotated ParsedSource-fixAnns ParsedModule {..} =- let ranns = relativiseApiAnns pm_parsed_source pm_annotations- in unsafeMkA pm_parsed_source ranns 0-#endif ------------------------------------------------------------------------------ @@ -694,66 +645,29 @@ -- | Given an 'LHSExpr', compute its exactprint annotations. -- Note that this function will throw away any existing annotations (and format) annotate :: (ASTElement l ast, Outputable l)-#if MIN_VERSION_ghc(9,2,0) => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)-#else- => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (Anns, LocatedAn l ast)-#endif annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) 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)+#else expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)-#else- (anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered- let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns- pure (anns',expr') #endif -- | Given an 'LHsDecl', compute its exactprint annotations. annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)-#if !MIN_VERSION_ghc(9,2,0)--- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain--- multiple matches. To work around this, we split the single--- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match',--- and then merge them all back together.-annotateDecl dflags- (L src (- ValD ext fb@FunBind- { fun_matches = mg@MG { mg_alts = L alt_src alts@(_:_)}- })) = do- let set_matches matches =- ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }}-- (anns', alts') <- fmap unzip $ for alts $ \alt -> do- uniq <- show <$> uniqueSrcSpanT- let rendered = render dflags $ set_matches [alt]- lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case- (ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))- -> pure (setPrecedingLines alt' 1 0 ann, alt')- _ -> lift $ Left "annotateDecl: didn't parse a single FunBind match"-- modifyAnnsT $ mappend $ fold anns'- pure $ L src $ set_matches alts'-#endif annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0-#elif MIN_VERSION_ghc(9,2,0)+#else expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0-#else- (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered- let anns' = setPrecedingLines expr' 1 0 anns- modifyAnnsT $ mappend anns'- pure expr' #endif ------------------------------------------------------------------------------@@ -777,15 +691,9 @@ -- | Equality on SrcSpan's. -- Ignores the (Maybe BufSpan) field of SrcSpan's.-#if MIN_VERSION_ghc(9,2,0) eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ-#else-eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool-eqSrcSpanA l r = leftmost_smallest l r == EQ-#endif -#if MIN_VERSION_ghc(9,2,0) addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext addParensToCtxt close_dp = addOpen . addClose where@@ -830,4 +738,3 @@ isCommaAnn :: TrailingAnn -> Bool isCommaAnn AddCommaAnn{} = True isCommaAnn _ = False-#endif
src/Development/IDE/Plugin/CodeAction.hs view
@@ -76,6 +76,15 @@ #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif+import GHC (AddEpAnn (AddEpAnn),+ Anchor (anchor_op),+ AnchorOperation (..),+ AnnsModule (am_main),+ DeltaPos (..),+ EpAnn (..),+ EpaLocation (..),+ LEpaComment,+ hsmodAnn) import Ide.PluginUtils (extractTextInRange, subRange) import Ide.Types@@ -102,23 +111,6 @@ _file_text) import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~))-#if MIN_VERSION_ghc(9,2,0)-import GHC (AddEpAnn (AddEpAnn),- Anchor (anchor_op),- AnchorOperation (..),- AnnsModule (am_main),- DeltaPos (..),- EpAnn (..),- EpaLocation (..),- LEpaComment,- hsmodAnn)-#else-import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP),- DeltaPos,- KeywordId (G),- deltaRow,- mkAnnKey)-#endif ------------------------------------------------------------------------------------------------- @@ -235,9 +227,6 @@ Just imp -> do fmap (nfp,) $ liftEither $ rewriteToWEdit df doc-#if !MIN_VERSION_ghc(9,2,0)- (annsA ps)-#endif $ extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) @@ -308,16 +297,6 @@ findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls let grhs = m_grhss $ unLoc match-#if !MIN_VERSION_ghc(9,2,0)- span = getLoc $ reLoc $ grhssLocalBinds grhs- if _start range `isInsideSrcSpan` span- then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause- else do- grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)- case unLoc grhs of- GRHS _ _ bd -> findSigOfExpr (unLoc bd)- _ -> Nothing-#else msum [findSigOfBinds range (grhssLocalBinds grhs) -- where clause , do@@ -329,7 +308,6 @@ case unLoc grhs of GRHS _ _ bd -> findSigOfExpr (unLoc bd) ]-#endif findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go@@ -360,23 +338,12 @@ findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p) findInstanceHead df instanceHead decls = listToMaybe-#if !MIN_VERSION_ghc(9,2,0) [ hsib_body- | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB {hsib_body}})) <- decls,- showSDoc df (ppr hsib_body) == instanceHead- ]-#else- [ hsib_body | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls, showSDoc df (ppr hsib_body) == instanceHead ]-#endif -#if MIN_VERSION_ghc(9,2,0) findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e)-#else-findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)-#endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- Single:@@ -668,15 +635,9 @@ if isEmptyBag bag then [] else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag-#if !MIN_VERSION_ghc(9,2,0) case grhssLocalBinds of- (L _ (HsValBinds _ (ValBinds _ bag lsigs))) -> go bag lsigs- _ -> []-#else- case grhssLocalBinds of (HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs _ -> []-#endif findRelatedSpanForMatch _ _ _ = [] findRelatedSpanForHsBind@@ -1283,11 +1244,7 @@ -- (Pair x x') == (Pair y y') = x == y && x' == y' | Just [instanceLineStr, constraintFirstCharStr] <- matchRegexUnifySpaces _message "bound by the instance declaration at .+:([0-9]+):([0-9]+)"-#if !MIN_VERSION_ghc(9,2,0)- , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB{hsib_body}})))-#else , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig{sig_body = hsib_body})})))-#endif <- findDeclContainingLoc (Position (readPositionNumber instanceLineStr) (readPositionNumber constraintFirstCharStr)) hsmodDecls = Just hsib_body | otherwise@@ -1307,11 +1264,7 @@ suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _range} | Just [implicitT] <- matchRegexUnifySpaces _message "Unbound implicit parameter \\(([^:]+::.+)\\) arising", Just (L _ (ValD _ FunBind {fun_id = L _ funId})) <- findDeclContainingLoc (_start _range) hsmodDecls,-#if !MIN_VERSION_ghc(9,2,0)- Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}})-#else Just (TypeSig _ _ HsWC {hswc_body = (unLoc -> HsSig {sig_body = hsib_body})})-#endif <- findSigOfDecl (== funId) hsmodDecls = [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId)@@ -1347,11 +1300,7 @@ -- In an equation for ‘eq’: -- eq (Pair x y) (Pair x' y') = x == x' && y == y' | Just typeSignatureName <- findTypeSignatureName _message-#if !MIN_VERSION_ghc(9,2,0)- , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})-#else , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})-#endif <- findSigOfDecl ((T.unpack typeSignatureName ==) . showSDoc df . ppr) hsmodDecls , title <- actionTitle missingConstraint typeSignatureName = [(title, appendConstraint (T.unpack missingConstraint) sig)]@@ -1374,11 +1323,7 @@ -- Account for both "Redundant constraint" and "Redundant constraints". | "Redundant constraint" `T.isInfixOf` _message , Just typeSignatureName <- findTypeSignatureName _message-#if !MIN_VERSION_ghc(9,2,0)- , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})-#else , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})-#endif <- fmap(traceAst "redundantConstraint") $ findSigOfDeclRanged _range hsmodDecls , Just redundantConstraintList <- findRedundantConstraints _message , rewrite <- removeConstraint (toRemove df redundantConstraintList) sig@@ -1683,7 +1628,6 @@ -- The relative position of 'where' keyword (in lines, relative to the previous AST node). -- 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@@ -1718,18 +1662,7 @@ anchorOpLine UnchangedAnchor = 0 anchorOpLine (MovedAnchor (SameLine _)) = 0 anchorOpLine (MovedAnchor (DifferentLine line _)) = line-#else- whereKeywordLineOffset = do- ann <- annsA ps M.!? mkAnnKey (astA ps)- deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann- pure $ deltaRow deltaPos - -- Before ghc 9.2, DeltaPos doesn't take comment into account, so we don't need to sum line offset of comments.- filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos- filterWhere (keywordId, deltaPos) =- if keywordId == G AnnWhere then Just deltaPos else Nothing-#endif- findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) findPositionFromImports hsField f = case getLoc (f hsField) of RealSrcSpan s _ ->@@ -1977,47 +1910,25 @@ where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens . unqualify $ b-#if !MIN_VERSION_ghc(9,2,0)- ranges' (L _ (IEThingWith _ thing _ inners labels))- | T.unpack (printOutputable thing) == b' = []- | otherwise =- [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b']- ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b']-#else ranges' (L _ (IEThingWith _ thing _ inners)) | T.unpack (printOutputable thing) == b' = [] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b']-#endif ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]-#if !MIN_VERSION_ghc(9,2,0) rangesForBinding' b (L (locA -> l) (IEVar _ nm))- | L _ (IEPattern (L _ b')) <- nm- , T.unpack (printOutputable b') == b- = [l]-#else-rangesForBinding' b (L (locA -> l) (IEVar _ nm)) | L _ (IEPattern _ (L _ b')) <- nm , T.unpack (printOutputable b') == b = [l]-#endif rangesForBinding' b (L (locA -> l) x@IEVar{}) | T.unpack (printOutputable x) == b = [l] rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | T.unpack (printOutputable x) == b = [l] rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | T.unpack (printOutputable x) == b = [l]-#if !MIN_VERSION_ghc(9,2,0)-rangesForBinding' b (L l (IEThingWith _ thing _ inners labels))-#else rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners))-#endif | T.unpack (printOutputable thing) == b = [l] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b]-#if !MIN_VERSION_ghc(9,2,0)- ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b]-#endif rangesForBinding' _ _ = [] -- | 'allMatchRegex' combined with 'unifySpaces'
src/Development/IDE/Plugin/CodeAction/Args.hs view
@@ -122,12 +122,7 @@ toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $ runMaybeT $ do df <- MaybeT caaDf-#if !MIN_VERSION_ghc(9,2,0)- ps <- MaybeT caaAnnSource- let r = rewriteToEdit df (annsA ps) rw-#else let r = rewriteToEdit df rw-#endif pure $ fromRight [] r instance ToTextEdit a => ToTextEdit [a] where
src/Development/IDE/Plugin/CodeAction/ExactPrint.hs view
@@ -4,9 +4,6 @@ Rewrite (..), rewriteToEdit, rewriteToWEdit,-#if !MIN_VERSION_ghc(9,2,0)- transferAnn,-#endif -- * Utilities appendConstraint,@@ -37,7 +34,6 @@ import Development.IDE.Plugin.CodeAction.Util -- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports.-#if MIN_VERSION_ghc(9,2,0) import Control.Lens (_head, _last, over) import Data.Bifunctor (first) import Data.Default (Default (..))@@ -50,18 +46,6 @@ TrailingAnn (AddCommaAnn), addAnns, ann, emptyComments, noSrcSpanA, reAnnL) import Language.Haskell.GHC.ExactPrint.ExactPrint (makeDeltaAst, showAst)-#else-import Control.Applicative (Alternative ((<|>)))-import Control.Monad.Extra (whenJust)-import Data.Foldable (find)-import Data.Functor (($>))-import qualified Data.Map.Strict as Map-import Data.Maybe (fromJust, isJust,- isNothing, mapMaybe)-import qualified Development.IDE.GHC.Compat.Util as Util-import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),- KeywordId (G), mkAnnKey)-#endif ------------------------------------------------------------------------------@@ -70,23 +54,14 @@ -- given 'ast'. data Rewrite where Rewrite ::-#if !MIN_VERSION_ghc(9,2,0)- Annotate ast =>-#else (ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast), Outputable (GenLocated (Anno ast) ast), Data (GenLocated (Anno ast) ast)) =>-#endif -- | The 'SrcSpan' that we want to rewrite SrcSpan -> -- | The ast that we want to graft-#if !MIN_VERSION_ghc(9,2,0)- (DynFlags -> TransformT (Either String) (Located ast)) ->-#else (DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)) ->-#endif Rewrite -------------------------------------------------------------------------------#if MIN_VERSION_ghc(9,2,0) class ResetEntryDP ann where resetEntryDP :: GenLocated ann ast -> GenLocated ann ast instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where@@ -94,58 +69,32 @@ resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{ann=EpAnnNotUsed} x) (SameLine 0) instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where resetEntryDP = id-#endif -- | Convert a 'Rewrite' into a list of '[TextEdit]'. rewriteToEdit :: HasCallStack => DynFlags ->-#if !MIN_VERSION_ghc(9,2,0)- Anns ->-#endif Rewrite -> Either String [TextEdit] rewriteToEdit dflags-#if !MIN_VERSION_ghc(9,2,0)- anns-#endif (Rewrite dst f) = do (ast, anns , _) <- runTransformT-#if !MIN_VERSION_ghc(9,2,0)- anns-#endif $ do ast <- f dflags-#if !MIN_VERSION_ghc(9,2,0)- ast <$ setEntryDPT ast (DP (0, 0))-#else pure $ traceAst "REWRITE_result" $ resetEntryDP ast-#endif let editMap = [ TextEdit (fromJust $ srcSpanToRange dst) $ T.pack $ exactPrint ast-#if !MIN_VERSION_ghc(9,2,0)- (fst anns)-#endif ] pure editMap -- | Convert a 'Rewrite' into a 'WorkspaceEdit' rewriteToWEdit :: DynFlags -> Uri-#if !MIN_VERSION_ghc(9,2,0)- -> Anns-#endif -> Rewrite -> Either String WorkspaceEdit rewriteToWEdit dflags uri-#if !MIN_VERSION_ghc(9,2,0)- anns-#endif r = do edits <- rewriteToEdit dflags-#if !MIN_VERSION_ghc(9,2,0)- anns-#endif r return $ WorkspaceEdit@@ -156,35 +105,6 @@ ------------------------------------------------------------------------------ -#if !MIN_VERSION_ghc(9,2,0)--- | Fix the parentheses around a type context-fixParens ::- (Monad m, Data (HsType pass), pass ~ GhcPass p0) =>- Maybe DeltaPos ->- Maybe DeltaPos ->- LHsContext pass ->- TransformT m [LHsType pass]-fixParens- openDP closeDP- ctxt@(L _ elems) = do- -- Paren annotation for type contexts are usually quite screwed up- -- we remove duplicates and fix negative DPs- let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)]- modifyAnnsT $- Map.adjust- ( \x ->- let annsMap = Map.fromList (annsDP x)- in x- { annsDP =- Map.toList $- Map.alter (\_ -> openDP <|> Just dp00) (G AnnOpenP) $- Map.alter (\_ -> closeDP <|> Just dp00) (G AnnCloseP) $- annsMap <> parens- }- )- (mkAnnKey ctxt)- return $ map dropHsParTy elems-#endif dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass) dropHsParTy (L _ (HsParTy _ ty)) = ty@@ -198,14 +118,13 @@ removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" where go :: LHsType GhcPs -> Rewrite-#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,4,0)+#if !MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do #else go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do #endif let ctxt' = filter (not . toRemove) ctxt removeStuff = (toRemove <$> headMaybe ctxt) == Just True-#if MIN_VERSION_ghc(9,2,0) let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body return $ case ctxt' of [] -> hst_body'@@ -218,11 +137,6 @@ #endif , hst_body = hst_body' }-#else- when removeStuff $- setEntryDPT hst_body (DP (0, 0))- return $ L l $ it{hst_ctxt = L l' ctxt'}-#endif go (L _ (HsParTy _ ty)) = go ty go (L _ HsForAllTy{hst_body}) = go hst_body go (L l other) = Rewrite (locA l) $ \_ -> return $ L l other@@ -239,25 +153,10 @@ where #if MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do-#elif MIN_VERSION_ghc(9,2,0)- go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do #else- go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do+ go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do #endif constraint <- liftParseAST df constraintT-#if !MIN_VERSION_ghc(9,2,0)- setEntryDPT constraint (DP (0, 1))-- -- Paren annotations are usually attached to the first and last constraints,- -- rather than to the constraint list itself, so to preserve them we need to reposition them- closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt- openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt- ctxt' <- fixParens- (join openParenDP) (join closeParenDP)- (L l' ctxt)- addTrailingCommaT (last ctxt')- return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]}-#else constraint <- pure $ setEntryDP constraint (SameLine 1) let l'' = (fmap.fmap) (addParensToCtxt close_dp) l' -- For singleton constraints, the close Paren DP is attached to an HsPar wrapping the constraint@@ -271,7 +170,6 @@ #else return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]} #endif-#endif go (L _ HsForAllTy{hst_body}) = go hst_body go (L _ (HsParTy _ ty)) = go ty go ast@(L l _) = Rewrite (locA l) $ \df -> do@@ -279,7 +177,6 @@ constraint <- liftParseAST df constraintT lContext <- uniqueSrcSpanT lTop <- uniqueSrcSpanT-#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,4,0) let context = reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint] #else@@ -288,17 +185,6 @@ annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens] needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint ast <- pure $ setEntryDP ast (SameLine 1)-#else- let context = L lContext [constraint]- addSimpleAnnT context dp00 $- (G AnnDarrow, DP (0, 1)) :- concat- [ [ (G AnnOpenP, dp00)- , (G AnnCloseP, dp00)- ]- | hsTypeNeedsParens sigPrec $ unLoc constraint- ]-#endif return $ reLocA $ L lTop $ HsQualTy noExtField context ast @@ -306,34 +192,10 @@ :: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast)) => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast) liftParseAST df s = case parseAST df "" s of-#if !MIN_VERSION_ghc(9,2,0)- Right (anns, x) -> modifyAnnsT (anns <>) $> x-#else Right x -> pure (makeDeltaAst x)-#endif Left _ -> TransformT $ lift $ Left $ "No parse: " <> s -#if !MIN_VERSION_ghc(9,2,0)-lookupAnn :: (Data a, Monad m)- => KeywordId -> Located a -> TransformT m (Maybe DeltaPos)-lookupAnn comment la = do- anns <- getAnnsT- return $ Map.lookup (mkAnnKey la) anns >>= lookup comment . annsDP -dp00 :: DeltaPos-dp00 = DP (0, 0)---- | Copy anns attached to a into b with modification, then delete anns of a-transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) ()-transferAnn la lb f = do- anns <- getAnnsT- let oldKey = mkAnnKey la- newKey = mkAnnKey lb- oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns- putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns--#endif- headMaybe :: [a] -> Maybe a headMaybe [] = Nothing headMaybe (a : _) = Just a@@ -352,16 +214,11 @@ Rewrite (locA l) $ \df -> do case mparent of -- This will also work for `ImportAllConstructors`-#if !MIN_VERSION_ghc(9,2,0)- Just parent -> extendImportViaParent df parent identifier lDecl- _ -> extendImportTopLevel identifier lDecl-#else -- Parsed source in GHC 9.4 uses absolute position annotation (RealSrcSpan), -- while rewriting relies on relative positions. ghc-exactprint has the utility -- makeDeltaAst for relativization. Just parent -> extendImportViaParent df parent identifier (makeDeltaAst lDecl) _ -> extendImportTopLevel identifier (makeDeltaAst lDecl)-#endif -- | Add an identifier or a data type to import list. Expects a Delta AST --@@ -401,35 +258,12 @@ if x `elem` lies then TransformT $ lift (Left $ thing <> " already imported") else do-#if !MIN_VERSION_ghc(9,2,0)- anns <- getAnnsT- maybe (pure ()) addTrailingCommaT (lastMaybe lies)- addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []- addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]-- -- When the last item already has a trailing comma, we append a trailing comma to the new item.- let isAnnComma (G AnnComma, _) = True- isAnnComma _ = False- shouldAddTrailingComma = maybe False nodeHasComma (lastMaybe lies)- && not (nodeHasComma (L l' lies))-- nodeHasComma :: Data a => Located a -> Bool- nodeHasComma x = isJust $ Map.lookup (mkAnnKey x) anns >>= find isAnnComma . annsDP- when shouldAddTrailingComma (addTrailingCommaT x)-- -- Parens are attached to `lies`, so if `lies` was empty previously,- -- we need change the ann key from `[]` to `:` to keep parens and other anns.- unless hasSibling $- transferAnn (L l' lies) (L l' [x]) id- 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-#endif extendImportTopLevel _ _ = TransformT $ lift $ Left "Unable to extend the import list" wildCardSymbol :: String@@ -477,14 +311,7 @@ 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- transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]}- addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)]-#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)}@@ -492,15 +319,10 @@ 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 go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs)-#endif -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | 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@@ -510,19 +332,12 @@ newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' lies = L l' $ reverse pre ++ [L l'' thing] ++ xs return $ L l it'-#else- let thing = L l'' (IEThingWith noExtField twIE (IEWildcard 2) [] [])- modifyAnnsT (Map.map (\ann -> ann{annsDP = (G AnnDotdot, dp00) : annsDP ann}))- return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [thing] ++ xs)}-#endif | parent == unIEWrappedName ie , hasSibling <- not $ null lies' = do srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child-#if MIN_VERSION_ghc(9,2,0) childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0-#endif let alreadyImported = printOutputable (occName (unLoc childRdr)) `elem` map (printOutputable @OccName) (listify (const True) lies')@@ -534,12 +349,6 @@ 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@@ -549,7 +358,6 @@ [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs fixLast = if hasSibling then first addComma else id return $ L l it'-#endif go hide l' pre (x : xs) = go hide l' (x : pre) xs go hide l' pre [] | hasSibling <- not $ null pre = do@@ -560,12 +368,6 @@ parentRdr <- liftParseAST df parent let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child isParentOperator = hasParen parent-#if !MIN_VERSION_ghc(9,2,0)- when hasSibling $- addTrailingCommaT (head pre)- 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 #if MIN_VERSION_ghc(9,5,0)@@ -580,27 +382,10 @@ 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)- when isParentOperator $- addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))]- addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP 1 isParentOperator- addSimpleAnnT childRdr (DP (0, 0)) [(G AnnVal, dp00)]- addSimpleAnnT x (DP (0, 0)) [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, DP (0, 0))]- -- Parens are attached to `pre`, so if `pre` was empty previously,- -- we need change the ann key from `[]` to `:` to keep parens and other anns.- unless hasSibling $- transferAnn (L l' $ reverse pre) (L l' [x]) id-- let lies' = reverse pre ++ [x]-#else listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)] x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE] lies' = addCommaInImportList (reverse pre) x-#endif #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' lies')} #else@@ -608,7 +393,6 @@ #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. addCommaInImportList :: -- | Initial list@@ -641,7 +425,6 @@ -- Add the comma (if needed) fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a] fixLast = over _last (first (if existingTrailingComma then id else addComma))-#endif #if MIN_VERSION_ghc(9,5,0) unIEWrappedName :: IEWrappedName GhcPs -> String@@ -654,15 +437,6 @@ hasParen ('(' : _) = True hasParen _ = False -#if !MIN_VERSION_ghc(9,2,0)-unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)]-unqalDP c paren =- ( if paren- then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)]- else pure- )- (G AnnVal, dp00)-#endif ------------------------------------------------------------------------------ @@ -687,18 +461,11 @@ extendHiding :: String -> LImportDecl GhcPs ->-#if !MIN_VERSION_ghc(9,2,0)- Maybe (Located [LIE GhcPs]) ->-#else Maybe (XRec GhcPs [LIE GhcPs]) ->-#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) extendHiding symbol (L l idecls) mlies df = do L l' lies <- case mlies of-#if !MIN_VERSION_ghc(9,2,0)- Nothing -> flip L [] <$> uniqueSrcSpanT-#else Nothing -> do src <- uniqueSrcSpanT let ann = noAnnSrcSpanDP0 src@@ -708,46 +475,20 @@ ,al_close = Just $ AddEpAnn AnnCloseP (epl 0) } return $ L ann' []-#endif Just pr -> pure pr let hasSibling = not $ null lies src <- uniqueSrcSpanT top <- uniqueSrcSpanT rdr <- liftParseAST df symbol-#if MIN_VERSION_ghc(9,2,0) rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr)-#endif 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 lies <- pure $ over _head (`setEntryDP` SameLine 1) lies-#endif-#if !MIN_VERSION_ghc(9,2,0)- singleHide = L l' [x]- when (isNothing mlies) $ do- addSimpleAnnT- singleHide- dp00- [ (G AnnHiding, DP (0, 1))- , (G AnnOpenP, DP (0, 1))- , (G AnnCloseP, DP (0, 0))- ]- addSimpleAnnT x (DP (0, 0)) []- addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr- if hasSibling- then do- addTrailingCommaT x- addSimpleAnnT (head lies) (DP (0, 1)) []- unless (null $ tail lies) $- addTrailingCommaT (head lies) -- Why we need this?- 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@@ -759,11 +500,7 @@ deleteFromImport :: String -> LImportDecl GhcPs ->-#if !MIN_VERSION_ghc(9,2,0)- Located [LIE GhcPs] ->-#else XRec GhcPs [LIE GhcPs] ->-#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do@@ -777,24 +514,10 @@ { ideclHiding = Just (False, edited) #endif }-#if !MIN_VERSION_ghc(9,2,0)- -- avoid import A (foo,)- whenJust (lastMaybe deletedLies) removeTrailingCommaT- when (not (null lies) && null deletedLies) $ do- transferAnn llies edited id- addSimpleAnnT- edited- dp00- [ (G AnnOpenP, DP (0, 1))- , (G AnnCloseP, DP (0, 0))- ]-#endif pure lidecl' where deletedLies =-#if MIN_VERSION_ghc(9,2,0) over _last removeTrailingComma $-#endif mapMaybe killLie lies killLie :: LIE GhcPs -> Maybe (LIE GhcPs) killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam))))@@ -803,11 +526,7 @@ killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam)))) | nam == symbol = Nothing | otherwise = Just v-#if !MIN_VERSION_ghc(9,2,0)- killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons flds))-#else killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons))-#endif | nam == symbol = Nothing | otherwise = Just $@@ -817,7 +536,4 @@ ty wild (filter ((/= symbol) . unqualIEWrapName . unLoc) cons)-#if !MIN_VERSION_ghc(9,2,0)- (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds)-#endif killLie v = Just v
src/Development/IDE/Plugin/CodeAction/Util.hs view
@@ -9,16 +9,10 @@ import Development.IDE.GHC.Compat.ExactPrint as GHC import Development.IDE.GHC.Dump (showAstDataHtml) import GHC.Stack+import GHC.Utils.Outputable import System.Environment.Blank (getEnvDefault) import System.IO.Unsafe import Text.Printf-#if MIN_VERSION_ghc(9,2,0)-import GHC.Utils.Outputable-#else-import Development.IDE.GHC.Compat-import Development.IDE.GHC.Compat.Util-import Development.IDE.GHC.Util-#endif -------------------------------------------------------------------------------- -- Tracing exactprint terms @@ -38,11 +32,7 @@ | debugAST = trace doTrace x | otherwise = x where-#if MIN_VERSION_ghc(9,2,0) renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}-#else- renderDump = showSDocUnsafe . ppr-#endif htmlDump = showAstDataHtml x doTrace = unsafePerformIO $ do u <- U.newUnique@@ -50,8 +40,6 @@ writeFile htmlDumpFileName $ renderDump htmlDump return $ unlines [prettyCallStack callStack ++ ":"-#if MIN_VERSION_ghc(9,2,0) , exactPrint x-#endif , "file://" ++ htmlDumpFileName]
src/Development/IDE/Plugin/Plugins/AddArgument.hs view
@@ -5,10 +5,6 @@ import Development.IDE.GHC.ExactPrint (epl) import GHC.Parser.Annotation (TokenLocation (..)) #endif-#if !MIN_VERSION_ghc(9,2,1)-import qualified Data.Text as T-import Language.LSP.Protocol.Types (TextEdit)-#else import Control.Monad (join) import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..))@@ -39,12 +35,7 @@ runTransformT) import Language.Haskell.GHC.ExactPrint.Transform (d1) import Language.LSP.Protocol.Types-#endif -#if !MIN_VERSION_ghc(9,2,1)-plugin :: [(T.Text, [TextEdit])]-plugin = []-#else -- When GHC tells us that a variable is not bound, it will tell us either: -- - there is an unbound variable with a given type -- - there is an unbound variable (GHC provides no type suggestion)@@ -162,4 +153,3 @@ lsigTy' = hsTypeFromFunTypeAsList (insertArg loc args, res) in L annHsSig (HsSig xHsSig tyVarBndrs lsigTy') -#endif
test/Main.hs view
@@ -43,7 +43,6 @@ import Language.LSP.Test import System.Directory import System.FilePath-import System.Info.Extra (isMac, isWindows) import qualified System.IO.Extra import System.IO.Extra hiding (withTempDir) import System.Time.Extra@@ -325,9 +324,7 @@ , exportUnusedTests , addImplicitParamsConstraintTests , removeExportTests-#if MIN_VERSION_ghc(9,2,1) , Test.AddArgument.tests-#endif ] insertImportTests :: TestTree@@ -1315,7 +1312,7 @@ , "b :: A" , "b = ConstructorFoo" ])- , ignoreForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $+ , brokenForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $ testSession "extend single line qualified import with value" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where"@@ -1487,7 +1484,7 @@ , "import A (pattern Some)" , "k (Some x) = x" ])- , ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $+ , ignoreForGhcVersions [GHC92, GHC94] "Diagnostic message has no suggestions" $ testSession "type constructor name same as data constructor name" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where"@@ -1753,7 +1750,7 @@ suggestAddRecordFieldImportTests :: TestTree suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields when using OverloadedRecordDot" [ testGroup "The field is suggested when an instance resolution failure occurs"- [ ignoreFor (BrokenForGHC [GHC90, GHC94, GHC96]) "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest+ [ ignoreForGhcVersions [GHC90, GHC94, GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest ] ] where@@ -2222,9 +2219,6 @@ ++ txtB') ] -#if MIN_VERSION_ghc(9,2,1)-#endif- deleteUnusedDefinitionTests :: TestTree deleteUnusedDefinitionTests = testGroup "delete unused definition action" [ testSession "delete unused top level binding" $@@ -3195,7 +3189,7 @@ (R 2 0 2 11) "Export ‘bar’" Nothing- , ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $+ , ignoreForGhcVersions [GHC92, GHC94] "Diagnostic message has no suggestions" $ testSession "type is exported but not the constructor of same name" $ template (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"@@ -3845,45 +3839,10 @@ f dir' ignoreForGHC92 :: String -> TestTree -> TestTree-ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92])--ignoreForGHC94 :: String -> TestTree -> TestTree-ignoreForGHC94 = knownIssueFor Broken (BrokenForGHC [GHC94])--data BrokenTarget =- BrokenSpecific OS [GhcVersion]- -- ^Broken for `BrokenOS` with `GhcVersion`- | BrokenForOS OS- -- ^Broken for `BrokenOS`- | BrokenForGHC [GhcVersion]- -- ^Broken for `GhcVersion`- deriving (Show)---- | Ignore test for specific os and ghc with reason.-ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree-ignoreFor = knownIssueFor Ignore---- | Deal with `IssueSolution` for specific OS and GHC.-knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree-knownIssueFor solution = go . \case- BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers- BrokenForOS bos -> isTargetOS bos- BrokenForGHC vers -> isTargetGhc vers- where- isTargetOS = \case- Windows -> isWindows- MacOS -> isMac- Linux -> not isWindows && not isMac-- isTargetGhc = elem ghcVersion-- go True = case solution of- Broken -> expectFailBecause- Ignore -> ignoreTestBecause- go False = \_ -> id-+ignoreForGHC92 = ignoreForGhcVersions [GHC92] -data IssueSolution = Broken | Ignore deriving (Show)+brokenForGHC94 :: String -> TestTree -> TestTree+brokenForGHC94 = knownBrokenForGhcVersions [GHC94] -- | Assert that a value is not 'Nothing', and extract the value. assertJust :: MonadIO m => String -> Maybe a -> m a
test/Test/AddArgument.hs view
@@ -22,16 +22,15 @@ import Test.Hls+import qualified Test.Hls.FileSystem as FS import qualified Development.IDE.Plugin.CodeAction as Refactor+import System.FilePath ((<.>)) tests :: TestTree tests = testGroup "add argument"-#if !MIN_VERSION_ghc(9,2,1)- []-#else [ mkGoldenAddArgTest' "Hole" (r 0 0 0 50) "_new_def", mkGoldenAddArgTest "NoTypeSuggestion" (r 0 0 0 50), mkGoldenAddArgTest "MultipleDeclAlts" (r 0 0 0 50),@@ -63,13 +62,12 @@ <$> getCodeActions docB range liftIO $ actionTitle @?= ("Add argument ‘" <> varName <> "’ to function") executeCodeAction action- goldenWithHaskellDoc+ goldenWithHaskellDocInTmpDir def (mkPluginTestDescriptor Refactor.bindingsPluginDescriptor "ghcide-code-actions-bindings") (testFileName <> " (golden)")- "test/data/golden/add-arg"+ (FS.mkVirtualFileTree "test/data/golden/add-arg" (FS.directProject $ testFileName <.> "hs")) testFileName "expected" "hs" action-#endif
test/data/hover/RecordDotSyntax.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 902 {-# LANGUAGE OverloadedRecordDot, DuplicateRecordFields, NoFieldSelectors #-} module RecordDotSyntax ( module RecordDotSyntax) where@@ -18,4 +16,3 @@ x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b ++ x.c.z-#endif