Skip to content

Commit b2d735b

Browse files
9999years9999years
committed
Start work on GHC 9.4 compat
1 parent 62d1e5d commit b2d735b

File tree

5 files changed

+66
-40
lines changed

5 files changed

+66
-40
lines changed

‎plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs‎

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,6 @@
22
-- multiple ghc-exactprint versions, accepting that anything more ambitious is
33
-- pretty much impossible with the GHC 9.2 redesign of ghc-exactprint
44
module Development.IDE.GHC.Compat.ExactPrint
5-
#if MIN_VERSION_ghc(9,3,0)
6-
( ) where
7-
#else
85
( ExactPrint
96
, exactPrint
107
, makeDeltaAst
@@ -34,5 +31,3 @@ pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA
3431
pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast
3532
pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA))
3633
#endif
37-
38-
#endif

‎plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,10 @@ import GHC.Hs.Dump
88
import qualified Data.ByteString as B
99
import Development.IDE.GHC.Compat.Util
1010
import Generics.SYB (ext1Q, ext2Q, extQ)
11-
import GHC.Hs
11+
import GHC.Hs hiding (AnnLet)
1212
#endif
1313
#if MIN_VERSION_ghc(9,0,1)
14-
import GHC.Plugins
14+
import GHC.Plugins hiding (AnnLet)
1515
#else
1616
import GhcPlugins
1717
#endif
@@ -231,8 +231,13 @@ showAstDataHtml a0 = html $
231231
annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
232232
annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")
233233

234+
#if MIN_VERSION_ghc(9,4,0)
235+
annotationEpAnnHsLet :: EpAnn NoEpAnns -> SDoc
236+
annotationEpAnnHsLet = annotation' (text "EpAnn NoEpAnns")
237+
#else
234238
annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc
235239
annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet")
240+
#endif
236241

237242
annotationAnnList :: EpAnn AnnList -> SDoc
238243
annotationAnnList = annotation' (text "EpAnn AnnList")

‎plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs‎

Lines changed: 29 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,6 @@
33

44
-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
55
module Development.IDE.GHC.ExactPrint
6-
#if MIN_VERSION_ghc(9,3,0)
7-
( ) where
8-
#else
96
( Graft(..),
107
graftDecls,
118
graftDeclsWithM,
@@ -88,11 +85,14 @@ import Ide.PluginUtils
8885
import Language.Haskell.GHC.ExactPrint.Parsers
8986
import Language.LSP.Types
9087
import Language.LSP.Types.Capabilities (ClientCapabilities)
91-
import Retrie.ExactPrint hiding (Annotated (..),
92-
parseDecl, parseExpr,
88+
import Retrie.ExactPrint hiding (parseDecl,
89+
parseExpr,
9390
parsePattern,
9491
parseType)
95-
#if MIN_VERSION_ghc(9,2,0)
92+
#if MIN_VERSION_ghc(9,9,0)
93+
import GHC.Plugins (showSDoc)
94+
import GHC.Utils.Outputable (Outputable (ppr))
95+
#elif MIN_VERSION_ghc(9,2,0)
9696
import GHC (EpAnn (..),
9797
NameAdornment (NameParens),
9898
NameAnn (..),
@@ -550,7 +550,10 @@ annotate :: (ASTElement l ast, Outputable l)
550550
annotate dflags needs_space ast = do
551551
uniq <- show <$> uniqueSrcSpanT
552552
let rendered = render dflags ast
553-
#if MIN_VERSION_ghc(9,2,0)
553+
#if MIN_VERSION_ghc(9,4,0)
554+
expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
555+
pure expr'
556+
#elif MIN_VERSION_ghc(9,2,0)
554557
expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered
555558
pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
556559
#else
@@ -574,6 +577,21 @@ annotateDecl dflags
574577
let set_matches matches =
575578
ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }}
576579

580+
#if MIN_VERSION_ghc(9,2,0)
581+
alts' <- for alts $ \alt -> do
582+
uniq <- show <$> uniqueSrcSpanT
583+
let rendered = render dflags $ set_matches [alt]
584+
#if MIN_VERSION_ghc(9,4,0)
585+
lift (mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered) >>= \case
586+
#elif MIN_VERSION_ghc(9,2,0)
587+
lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case
588+
#endif
589+
(L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))
590+
-> pure alt'
591+
_ -> lift $ Left "annotateDecl: didn't parse a single FunBind match"
592+
593+
pure $ L src $ set_matches alts'
594+
#else
577595
(anns', alts') <- fmap unzip $ for alts $ \alt -> do
578596
uniq <- show <$> uniqueSrcSpanT
579597
let rendered = render dflags $ set_matches [alt]
@@ -591,6 +609,10 @@ annotateDecl dflags ast = do
591609
#if MIN_VERSION_ghc(9,2,0)
592610
expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered
593611
pure $ setPrecedingLines expr' 1 0
612+
#if MIN_VERSION_ghc(9,4,0)
613+
lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered
614+
#elif MIN_VERSION_ghc(9,2,0)
615+
lift $ mapLeft show $ parseDecl dflags uniq rendered
594616
#else
595617
(anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered
596618
let anns' = setPrecedingLines expr' 1 0 anns
@@ -673,5 +695,3 @@ isCommaAnn :: TrailingAnn -> Bool
673695
isCommaAnn AddCommaAnn{} = True
674696
isCommaAnn _ = False
675697
#endif
676-
677-
#endif

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs‎

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -136,12 +136,10 @@ iePluginDescriptor recorder plId =
136136
wrap suggestExportUnusedTopBinding
137137
, wrap suggestModuleTypo
138138
, wrap suggestFixConstructorImport
139-
#if !MIN_VERSION_ghc(9,3,0)
140139
, wrap suggestExtendImport
141140
, wrap suggestImportDisambiguation
142141
, wrap suggestNewOrExtendImportForClassMethod
143142
, wrap suggestHideShadow
144-
#endif
145143
, wrap suggestNewImport
146144
]
147145
plId
@@ -153,20 +151,16 @@ typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
153151
wrap $ suggestSignature True
154152
, wrap suggestFillTypeWildcard
155153
, wrap suggestAddTypeAnnotationToSatisfyContraints
156-
#if !MIN_VERSION_ghc(9,3,0)
157154
, wrap removeRedundantConstraints
158155
, wrap suggestConstraint
159-
#endif
160156
]
161157
plId
162158

163159
bindingsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
164160
bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
165161
mkGhcideCAsPlugin [
166162
wrap suggestReplaceIdentifier
167-
#if !MIN_VERSION_ghc(9,3,0)
168163
, wrap suggestImplicitParameter
169-
#endif
170164
, wrap suggestNewDefinition
171165
, wrap suggestDeleteUnusedBinding
172166
]
@@ -1030,7 +1024,6 @@ getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of
10301024
indentation :: T.Text -> Int
10311025
indentation = T.length . T.takeWhile isSpace
10321026

1033-
#if !MIN_VERSION_ghc(9,3,0)
10341027
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
10351028
suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}
10361029
| Just [binding, mod, srcspan] <-
@@ -1078,7 +1071,6 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
10781071
, parent = Nothing
10791072
, isDatacon = False
10801073
, moduleNameText = mod}
1081-
#endif
10821074

10831075
data HidingMode
10841076
= HideOthers [ModuleTarget]

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs‎

Lines changed: 30 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -196,26 +196,30 @@ removeConstraint ::
196196
removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input"
197197
where
198198
go :: LHsType GhcPs -> Rewrite
199-
#if !MIN_VERSION_ghc(9,2,0)
200-
go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do
201-
#else
199+
#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,4,0)
202200
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do
201+
#else
202+
go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do
203203
#endif
204204
let ctxt' = filter (not . toRemove) ctxt
205205
removeStuff = (toRemove <$> headMaybe ctxt) == Just True
206-
#if !MIN_VERSION_ghc(9,2,0)
207-
when removeStuff $
208-
setEntryDPT hst_body (DP (0, 0))
209-
return $ L l $ it{hst_ctxt = L l' ctxt'}
210-
#else
206+
#if MIN_VERSION_ghc(9,2,0)
211207
let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body
212208
return $ case ctxt' of
213209
[] -> hst_body'
214210
_ -> do
215211
let ctxt'' = over _last (first removeComma) ctxt'
212+
#if MIN_VERSION_ghc(9,4,0)
213+
L l $ it{ hst_ctxt = L l' ctxt''
214+
#else
216215
L l $ it{ hst_ctxt = Just $ L l' ctxt''
216+
#endif
217217
, hst_body = hst_body'
218218
}
219+
#else
220+
when removeStuff $
221+
setEntryDPT hst_body (DP (0, 0))
222+
return $ L l $ it{hst_ctxt = L l' ctxt'}
219223
#endif
220224
go (L _ (HsParTy _ ty)) = go ty
221225
go (L _ HsForAllTy{hst_body}) = go hst_body
@@ -231,10 +235,12 @@ appendConstraint ::
231235
Rewrite
232236
appendConstraint constraintT = go . traceAst "appendConstraint"
233237
where
234-
#if !MIN_VERSION_ghc(9,2,0)
238+
#if MIN_VERSION_ghc(9,4,0)
235239
go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do
236-
#else
240+
#elif MIN_VERSION_ghc(9,2,0)
237241
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do
242+
#else
243+
go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do
238244
#endif
239245
constraint <- liftParseAST df constraintT
240246
#if !MIN_VERSION_ghc(9,2,0)
@@ -258,7 +264,11 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
258264
[L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close
259265
_ -> Nothing
260266
ctxt' = over _last (first addComma) $ map dropHsParTy ctxt
267+
#if MIN_VERSION_ghc(9,4,0)
268+
return $ L l $ it{hst_ctxt = L l'' $ ctxt' ++ [constraint]}
269+
#else
261270
return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]}
271+
#endif
262272
#endif
263273
go (L _ HsForAllTy{hst_body}) = go hst_body
264274
go (L _ (HsParTy _ ty)) = go ty
@@ -267,7 +277,16 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
267277
constraint <- liftParseAST df constraintT
268278
lContext <- uniqueSrcSpanT
269279
lTop <- uniqueSrcSpanT
270-
#if !MIN_VERSION_ghc(9,2,0)
280+
#if MIN_VERSION_ghc(9,2,0)
281+
#if MIN_VERSION_ghc(9,4,0)
282+
let context = reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
283+
#else
284+
let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
285+
#endif
286+
annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]
287+
needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint
288+
ast <- pure $ setEntryDP ast (SameLine 1)
289+
#else
271290
let context = L lContext [constraint]
272291
addSimpleAnnT context dp00 $
273292
(G AnnDarrow, DP (0, 1)) :
@@ -277,11 +296,6 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
277296
]
278297
| hsTypeNeedsParens sigPrec $ unLoc constraint
279298
]
280-
#else
281-
let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
282-
annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]
283-
needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint
284-
ast <- pure $ setEntryDP ast (SameLine 1)
285299
#endif
286300

287301
return $ reLocA $ L lTop $ HsQualTy noExtField context ast

0 commit comments

Comments
 (0)