Skip to content

Commit ac9f3fb

Browse files
drsoochdrsooch
committed
Update hls-retrie-plugin to be usable with 9.2.4.
This is the first pass at getting hls-retrie-plugin enabled. Much of the changes were updating to match the changes in the upstream `retrie` package.
1 parent 7317750 commit ac9f3fb

File tree

4 files changed

+60
-31
lines changed

4 files changed

+60
-31
lines changed

‎ghcide/src/Development/IDE/GHC/Compat/Core.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -205,6 +205,7 @@ module Development.IDE.GHC.Compat.Core (
205205
getLocA,
206206
locA,
207207
noLocA,
208+
unLocA,
208209
LocatedAn,
209210
#if MIN_VERSION_ghc(9,2,0)
210211
GHC.AnnListItem(..),
@@ -1044,6 +1045,13 @@ locA = GHC.locA
10441045
locA = id
10451046
#endif
10461047

1048+
#if MIN_VERSION_ghc(9,2,0)
1049+
unLocA :: forall pass a. XRec (GhcPass pass) a -> a
1050+
unLocA = unXRec @(GhcPass pass)
1051+
#else
1052+
unLocA = id
1053+
#endif
1054+
10471055
#if MIN_VERSION_ghc(9,2,0)
10481056
getLocA :: SrcLoc.GenLocated (SrcSpanAnn' a) e -> SrcSpan
10491057
getLocA = GHC.getLocA

‎haskell-language-server.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -275,7 +275,7 @@ common rename
275275
cpp-options: -Dhls_rename
276276

277277
common retrie
278-
if flag(retrie) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))
278+
if flag(retrie)
279279
build-depends: hls-retrie-plugin ^>= 1.0
280280
cpp-options: -Dhls_retrie
281281

‎plugins/hls-retrie-plugin/hls-retrie-plugin.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: hls-retrie-plugin
3-
version: 1.0.2.1
3+
version: 1.0.2.2
44
synopsis: Retrie integration plugin for Haskell Language Server
55
description:
66
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
@@ -25,6 +25,7 @@ library
2525
, extra
2626
, ghc
2727
, ghcide ^>=1.7
28+
, ghc-paths
2829
, hashable
2930
, hls-plugin-api ^>=1.4
3031
, lsp

‎plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs

Lines changed: 49 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@
1111
{-# LANGUAGE StandaloneDeriving #-}
1212
{-# LANGUAGE TypeApplications #-}
1313
{-# LANGUAGE TypeFamilies #-}
14+
{-# LANGUAGE ViewPatterns #-}
1415

1516
{-# OPTIONS -Wno-orphans #-}
1617

@@ -51,13 +52,13 @@ import Development.IDE hiding (pluginHandlers)
5152
import Development.IDE.Core.PositionMapping
5253
import Development.IDE.Core.Shake (ShakeExtras (knownTargetsVar),
5354
toKnownFiles)
54-
import Development.IDE.GHC.Compat (GenLocated (L), GhcRn,
55+
import Development.IDE.GHC.Compat (GenLocated (L), GhcPs,
56+
GhcRn, GhcTc,
5557
HsBindLR (FunBind),
5658
HsGroup (..),
5759
HsValBindsLR (..),
5860
HscEnv, IdP, LRuleDecls,
5961
ModSummary (ModSummary, ms_hspp_buf, ms_mod),
60-
NHsValBindsLR (..),
6162
Outputable,
6263
ParsedModule (..),
6364
RuleDecl (HsRule),
@@ -67,21 +68,24 @@ import Development.IDE.GHC.Compat (GenLocated (L), GhcRn,
6768
TyClDecl (SynDecl),
6869
TyClGroup (..), fun_id,
6970
hm_iface, isQual,
70-
isQual_maybe,
71+
isQual_maybe, locA,
7172
mi_fixities,
7273
moduleNameString,
7374
nameModule_maybe,
74-
nameRdrName, occNameFS,
75-
occNameString,
76-
parseModule,
75+
nameRdrName, noLocA,
76+
occNameFS, occNameString,
7777
pattern IsBoot,
7878
pattern NotBoot,
7979
pattern RealSrcSpan,
80+
pm_parsed_source,
8081
rdrNameOcc, rds_rules,
81-
srcSpanFile)
82+
srcSpanFile, unLocA)
8283
import Development.IDE.GHC.Compat.Util hiding (catch, try)
83-
import qualified GHC (parseModule)
84+
import qualified GHC (Module,
85+
ParsedModule (..),
86+
moduleName, parseModule)
8487
import GHC.Generics (Generic)
88+
import GHC.Paths (libdir)
8589
import Ide.PluginUtils
8690
import Ide.Types
8791
import Language.LSP.Server (LspM,
@@ -94,8 +98,13 @@ import Language.LSP.Types as J hiding
9498
SemanticTokenRelative (length),
9599
SemanticTokensEdit (_start))
96100
import Retrie.CPP (CPP (NoCPP), parseCPP)
97-
import Retrie.ExactPrint (fix, relativiseApiAnns,
101+
import Retrie.ExactPrint (Annotated, fix,
98102
transformA, unsafeMkA)
103+
#if MIN_VERSION_ghc(9,2,0)
104+
import Retrie.ExactPrint (makeDeltaAst)
105+
#else
106+
import Retrie.ExactPrint (relativiseApiAnns)
107+
#endif
99108
import Retrie.Fixity (mkFixityEnv)
100109
import qualified Retrie.GHC as GHC
101110
import Retrie.Monad (addImports, apply,
@@ -202,7 +211,7 @@ provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca)
202211
++ concatMap (suggestRuleRewrites uri pos ms_mod) hs_ruleds
203212
++ [ r
204213
| TyClGroup {group_tyclds} <- hs_tyclds,
205-
L l g <- group_tyclds,
214+
L (locA -> l) g <- group_tyclds,
206215
pos `isInsideSrcSpan` l,
207216
r <- suggestTypeRewrites uri ms_mod g
208217

@@ -225,7 +234,7 @@ getBinds nfp = runMaybeT $ do
225234
( HsGroup
226235
{ hs_valds =
227236
XValBindsLR
228-
(NValBinds binds _sigs :: NHsValBindsLR GHC.GhcRn),
237+
(GHC.NValBinds binds _sigs :: GHC.NHsValBindsLR GhcRn),
229238
hs_ruleds,
230239
hs_tyclds
231240
},
@@ -247,7 +256,7 @@ suggestBindRewrites ::
247256
GHC.Module ->
248257
HsBindLR GhcRn GhcRn ->
249258
[(T.Text, CodeActionKind, RunRetrieParams)]
250-
suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L l' rdrName}
259+
suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L (locA -> l') rdrName}
251260
| pos `isInsideSrcSpan` l' =
252261
let pprNameText = printOutputable rdrName
253262
pprName = T.unpack pprNameText
@@ -267,13 +276,13 @@ describeRestriction restrictToOriginatingFile =
267276
if restrictToOriginatingFile then " in current file" else ""
268277

269278
suggestTypeRewrites ::
270-
(Outputable (IdP pass)) =>
279+
(Outputable (IdP GhcRn)) =>
271280
Uri ->
272281
GHC.Module ->
273-
TyClDecl pass ->
282+
TyClDecl GhcRn ->
274283
[(T.Text, CodeActionKind, RunRetrieParams)]
275-
suggestTypeRewrites originatingFile ms_mod SynDecl {tcdLName = L _ rdrName} =
276-
let pprNameText = printOutputable rdrName
284+
suggestTypeRewrites originatingFile ms_mod SynDecl {tcdLName} =
285+
let pprNameText = printOutputable (unLocA tcdLName)
277286
pprName = T.unpack pprNameText
278287
unfoldRewrite restrictToOriginatingFile =
279288
let rewrites = [TypeForward (qualify ms_mod pprName)]
@@ -290,7 +299,7 @@ suggestRuleRewrites ::
290299
Uri ->
291300
Position ->
292301
GHC.Module ->
293-
LRuleDecls pass ->
302+
LRuleDecls GhcRn ->
294303
[(T.Text, CodeActionKind, RunRetrieParams)]
295304
suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) =
296305
concat
@@ -299,7 +308,7 @@ suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) =
299308
, backwardsRewrite ruleName True
300309
, backwardsRewrite ruleName False
301310
]
302-
| L l r <- rds_rules,
311+
| L (locA -> l) r <- rds_rules,
303312
pos `isInsideSrcSpan` l,
304313
#if MIN_VERSION_ghc(8,8,0)
305314
let HsRule {rd_name = L _ (_, rn)} = r,
@@ -327,8 +336,6 @@ suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) =
327336
RunRetrieParams {..}
328337
)
329338

330-
suggestRuleRewrites _ _ _ _ = []
331-
332339
qualify :: GHC.Module -> String -> String
333340
qualify ms_mod x = T.unpack (printOutputable ms_mod) <> "." <> x
334341

@@ -360,10 +367,9 @@ callRetrie ::
360367
callRetrie state session rewrites origin restrictToOriginatingFile = do
361368
knownFiles <- toKnownFiles . unhashed <$> readTVarIO (knownTargetsVar $ shakeExtras state)
362369
let reuseParsedModule f = do
363-
pm <-
364-
useOrFail "GetParsedModule" NoParse GetParsedModule f
365-
(fixities, pm) <- fixFixities f (fixAnns pm)
366-
return (fixities, pm)
370+
pm <- useOrFail "GetParsedModule" NoParse GetParsedModule f
371+
(fixities, pm') <- fixFixities f (fixAnns pm)
372+
return (fixities, pm')
367373
getCPPmodule t = do
368374
nt <- toNormalizedFilePath' <$> makeAbsolute t
369375
let getParsedModule f contents = do
@@ -375,8 +381,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do
375381
Just (stringToStringBuffer contents)
376382
}
377383
logPriority (ideLogger state) Info $ T.pack $ "Parsing module: " <> t
378-
parsed <-
379-
evalGhcEnv session (GHC.parseModule ms')
384+
parsed <- evalGhcEnv session (GHC.parseModule ms')
380385
`catch` \e -> throwIO (GHCParseError nt (show @SomeException e))
381386
(fixities, parsed) <- fixFixities f (fixAnns parsed)
382387
return (fixities, parsed)
@@ -416,12 +421,19 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do
416421
(theImports, theRewrites) = partitionEithers rewrites
417422

418423
annotatedImports =
419-
unsafeMkA (map (GHC.noLoc . toImportDecl) theImports) mempty 0
424+
#if MIN_VERSION_ghc(9,2,0)
425+
unsafeMkA (map (noLocA . toImportDecl) theImports) 0
426+
#else
427+
unsafeMkA (map (noLocA . toImportDecl) theImports) mempty 0
428+
#endif
420429

421430
(originFixities, originParsedModule) <- reuseParsedModule origin
422431
retrie <-
423432
(\specs -> apply specs >> addImports annotatedImports)
424433
<$> parseRewriteSpecs
434+
#if MIN_VERSION_ghc(9,2,0)
435+
libdir -- TODO: does this actualy get the proper libdir?
436+
#endif
425437
(\_f -> return $ NoCPP originParsedModule)
426438
originFixities
427439
theRewrites
@@ -463,9 +475,13 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do
463475
let fixities = fixityEnvFromModIface hirModIface
464476
res <- transformA pm (fix fixities)
465477
return (fixities, res)
466-
fixAnns ParsedModule {..} =
478+
#if MIN_VERSION_ghc(9,2,0)
479+
fixAnns GHC.ParsedModule{pm_parsed_source} = unsafeMkA (makeDeltaAst pm_parsed_source) 0
480+
#else
481+
fixAnns GHC.ParsedModule {..} =
467482
let ranns = relativiseApiAnns pm_parsed_source pm_annotations
468483
in unsafeMkA pm_parsed_source ranns 0
484+
#endif
469485

470486
asEditMap :: [[(Uri, TextEdit)]] -> WorkspaceEditMap
471487
asEditMap = coerce . HM.fromListWith (++) . concatMap (map (second pure))
@@ -533,14 +549,18 @@ toImportDecl :: ImportSpec -> GHC.ImportDecl GHC.GhcPs
533549
toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..}
534550
where
535551
ideclSource' = if ideclSource then IsBoot else NotBoot
536-
toMod = GHC.noLoc . GHC.mkModuleName
552+
toMod = noLocA . GHC.mkModuleName
537553
ideclName = toMod ideclNameString
538554
ideclPkgQual = Nothing
539555
ideclSafe = False
540556
ideclImplicit = False
541557
ideclHiding = Nothing
542558
ideclSourceSrc = NoSourceText
559+
#if MIN_VERSION_ghc(9,2,0)
560+
ideclExt = GHC.EpAnnNotUsed
561+
#else
543562
ideclExt = GHC.noExtField
563+
#endif
544564
ideclAs = toMod <$> ideclAsString
545565
#if MIN_VERSION_ghc(8,10,0)
546566
ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified

0 commit comments

Comments
 (0)