Skip to content

Commit cf59f50

Browse files
wz1000wz1000
committed
Exactprint plugins for 9.8
1 parent 1c62ba3 commit cf59f50

File tree

15 files changed

+101
-86
lines changed

15 files changed

+101
-86
lines changed

‎cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ packages:
3636
./plugins/hls-overloaded-record-dot-plugin
3737
./plugins/hls-semantic-tokens-plugin
3838

39-
index-state: 2024-01-13T19:06:05Z
39+
index-state: 2024-01-17T19:06:05Z
4040

4141
tests: True
4242
test-show-details: direct

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -408,6 +408,7 @@ module Development.IDE.GHC.Compat.Core (
408408
#endif
409409
groupOrigin,
410410
isVisibleFunArg,
411+
lookupGlobalRdrEnv,
411412
) where
412413

413414
import qualified GHC
@@ -825,3 +826,7 @@ mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Noth
825826
#else
826827
mkSimpleTarget _ fp = Target (TargetFile fp Nothing) True Nothing
827828
#endif
829+
830+
#if MIN_VERSION_ghc(9,7,0)
831+
lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevantGREs)
832+
#endif

‎haskell-language-server.cabal

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -217,7 +217,7 @@ common cabal
217217
cpp-options: -Dhls_cabal
218218

219219
common class
220-
if flag(class) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
220+
if flag(class)
221221
build-depends: hls-class-plugin == 2.5.0.0
222222
cpp-options: -Dhls_class
223223

@@ -237,12 +237,12 @@ common importLens
237237
cpp-options: -Dhls_importLens
238238

239239
common rename
240-
if flag(rename) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
240+
if flag(rename)
241241
build-depends: hls-rename-plugin == 2.5.0.0
242242
cpp-options: -Dhls_rename
243243

244244
common retrie
245-
if flag(retrie) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
245+
if flag(retrie)
246246
build-depends: hls-retrie-plugin == 2.5.0.0
247247
cpp-options: -Dhls_retrie
248248

@@ -267,7 +267,7 @@ common pragmas
267267
cpp-options: -Dhls_pragmas
268268

269269
common splice
270-
if flag(splice) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
270+
if flag(splice)
271271
build-depends: hls-splice-plugin == 2.5.0.0
272272
cpp-options: -Dhls_splice
273273

@@ -292,7 +292,7 @@ common changeTypeSignature
292292
cpp-options: -Dhls_changeTypeSignature
293293

294294
common gadt
295-
if flag(gadt) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
295+
if flag(gadt)
296296
build-depends: hls-gadt-plugin == 2.5.0.0
297297
cpp-options: -Dhls_gadt
298298

@@ -334,7 +334,7 @@ common stylishHaskell
334334
cpp-options: -Dhls_stylishHaskell
335335

336336
common refactor
337-
if flag(refactor) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))
337+
if flag(refactor)
338338
build-depends: hls-refactor-plugin == 2.5.0.0
339339
cpp-options: -Dhls_refactor
340340

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

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -25,11 +25,6 @@ source-repository head
2525
location: https://github.com/haskell/haskell-language-server.git
2626

2727
library
28-
-- Plugins that need exactprint have not been updated for 9.8 yet
29-
if impl(ghc >= 9.8)
30-
buildable: False
31-
else
32-
buildable: True
3328
exposed-modules: Ide.Plugin.Class
3429
other-modules: Ide.Plugin.Class.CodeAction
3530
, Ide.Plugin.Class.CodeLens
@@ -68,10 +63,6 @@ library
6863
ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing
6964

7065
test-suite tests
71-
if impl(ghc >= 9.8)
72-
buildable: False
73-
else
74-
buildable: True
7566
type: exitcode-stdio-1.0
7667
default-language: Haskell2010
7768
hs-source-dirs: test

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE RecordWildCards #-}
66
{-# LANGUAGE TypeFamilies #-}
77
{-# LANGUAGE ViewPatterns #-}
8+
{-# LANGUAGE CPP #-}
89

910
module Ide.Plugin.Class.Types where
1011

@@ -208,7 +209,11 @@ getInstanceBindTypeSigsRule recorder = do
208209
(hscEnv -> hsc) <- useMT GhcSession nfp
209210
let binds = collectHsBindsBinders $ tcg_binds gblEnv
210211
(_, maybe [] catMaybes -> instanceBinds) <- liftIO $
211-
initTcWithGbl hsc gblEnv ghostSpan $ traverse bindToSig binds
212+
initTcWithGbl hsc gblEnv ghostSpan
213+
#if MIN_VERSION_ghc(9,7,0)
214+
$ liftZonkM
215+
#endif
216+
$ traverse bindToSig binds
212217
pure $ InstanceBindTypeSigsResult instanceBinds
213218
where
214219
bindToSig id = do

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

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -20,11 +20,6 @@ source-repository head
2020
location: https://github.com/haskell/haskell-language-server.git
2121

2222
library
23-
-- Plugins that need exactprint have not been updated for 9.8 yet
24-
if impl(ghc >= 9.8)
25-
buildable: False
26-
else
27-
buildable: True
2823
exposed-modules: Ide.Plugin.GADT
2924
other-modules: Ide.Plugin.GHC
3025

@@ -55,10 +50,6 @@ library
5550
default-extensions: DataKinds
5651

5752
test-suite tests
58-
if impl(ghc >= 9.8)
59-
buildable: False
60-
else
61-
buildable: True
6253
type: exitcode-stdio-1.0
6354
default-language: Haskell2010
6455
hs-source-dirs: test

‎plugins/hls-gadt-plugin/test/Main.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,13 +35,13 @@ tests = testGroup "GADT"
3535
, runTest "ConstructorContext" "ConstructorContext" 2 0 2 38
3636
, runTest "Context" "Context" 2 0 4 41
3737
, runTest "Pragma" "Pragma" 2 0 3 29
38-
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "Single deriving has different output on ghc9.2+" $
38+
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96, GHC98]) "Single deriving has different output on ghc9.2+" $
3939
runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14
40-
, knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "Single deriving has different output on ghc9.2+" $
40+
, knownBrokenForGhcVersions [GHC92,GHC94,GHC96, GHC98] "Single deriving has different output on ghc9.2+" $
4141
runTest "SingleDeriving" "SingleDeriving" 2 0 3 14
42-
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "only ghc-9.2+ enabled GADTs pragma implicitly" $
42+
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96, GHC98]) "only ghc-9.2+ enabled GADTs pragma implicitly" $
4343
gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False
44-
, knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "ghc-9.2 has enabled GADTs pragma implicitly" $
44+
, knownBrokenForGhcVersions [GHC92,GHC94,GHC96, GHC98] "ghc-9.2 has enabled GADTs pragma implicitly" $
4545
gadtPragmaTest "insert pragma" True
4646
]
4747

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

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -22,11 +22,6 @@ source-repository head
2222
location: https://github.com/haskell/haskell-language-server.git
2323

2424
library
25-
-- Plugins that need exactprint have not been updated for 9.8 yet
26-
if impl(ghc >= 9.8)
27-
buildable: False
28-
else
29-
buildable: True
3025
exposed-modules: Development.IDE.GHC.ExactPrint
3126
Development.IDE.GHC.Compat.ExactPrint
3227
Development.IDE.Plugin.CodeAction
@@ -98,10 +93,6 @@ library
9893
default-language: Haskell2010
9994

10095
test-suite tests
101-
if impl(ghc >= 9.8)
102-
buildable: False
103-
else
104-
buildable: True
10596
type: exitcode-stdio-1.0
10697
default-language: Haskell2010
10798
hs-source-dirs: test

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,11 @@ showAstDataHtml a0 = html $
123123

124124
sourceText :: SourceText -> SDoc
125125
sourceText NoSourceText = text "NoSourceText"
126+
#if MIN_VERSION_ghc(9,7,0)
127+
sourceText (SourceText src) = text "SourceText" <+> ftext src
128+
#else
126129
sourceText (SourceText src) = text "SourceText" <+> text src
130+
#endif
127131

128132
epaAnchor :: EpaLocation -> SDoc
129133
#if MIN_VERSION_ghc(9,5,0)

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

Lines changed: 38 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -938,7 +938,11 @@ suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Cod
938938
suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}
939939
| Just [binding, mod, srcspan] <-
940940
matchRegexUnifySpaces _message
941+
#if MIN_VERSION_ghc(9,7,0)
942+
"Add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\(at (.*)\\)."
943+
#else
941944
"Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)."
945+
#endif
942946
= suggestions hsmodImports binding mod srcspan
943947
| Just (binding, mod_srcspan) <-
944948
matchRegExMultipleImports _message
@@ -965,9 +969,13 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
965969
| otherwise = []
966970
lookupExportMap binding mod
967971
| let em = getExportsMap exportsMap
972+
#if MIN_VERSION_ghc(9,7,0)
973+
match = mconcat $ lookupOccEnv_AllNameSpaces em (mkVarOrDataOcc binding)
974+
#else
968975
match1 = lookupOccEnv em (mkVarOrDataOcc binding)
969976
match2 = lookupOccEnv em (mkTypeOcc binding)
970977
, Just match <- match1 <> match2
978+
#endif
971979
-- Only for the situation that data constructor name is same as type constructor name,
972980
-- let ident with parent be in front of the one without.
973981
, sortedMatch <- sortBy (\ident1 ident2 -> parent ident2 `compare` parent ident1) (Set.toList match)
@@ -1165,9 +1173,20 @@ suggestFixConstructorImport Diagnostic{_range=_range,..}
11651173
-- import Data.Aeson.Types( Result( Success ) )
11661174
-- or
11671175
-- import Data.Aeson.Types( Result(..) ) (lsp-ui)
1176+
--
1177+
-- On 9.8+
1178+
--
1179+
-- In the import of ‘ModuleA’:
1180+
-- an item called ‘Constructor’
1181+
-- is exported, but it is a data constructor of
1182+
-- ‘A’.
11681183
| Just [constructor, typ] <-
11691184
matchRegexUnifySpaces _message
1185+
#if MIN_VERSION_ghc(9,7,0)
1186+
"an item called ‘([^’]*)’ is exported, but it is a data constructor of ‘([^’]*)’"
1187+
#else
11701188
"‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
1189+
#endif
11711190
= let fixedImport = typ <> "(" <> constructor <> ")"
11721191
in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)]
11731192
| otherwise = []
@@ -1952,30 +1971,32 @@ regexSingleMatch msg regex = case matchRegexUnifySpaces msg regex of
19521971
Just (h:_) -> Just h
19531972
_ -> Nothing
19541973

1955-
-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and
1956-
-- | return (Data.Map, app/ModuleB.hs:2:1-18)
1957-
regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text)
1958-
regExPair (modname, srcpair) = do
1959-
x <- regexSingleMatch modname "‘([^’]*)’"
1960-
y <- regexSingleMatch srcpair "\\((.*)\\)"
1961-
return (x, y)
1962-
19631974
-- | Process a list of (module_name, filename:src_span) values
19641975
-- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)]
19651976
regExImports :: T.Text -> Maybe [(T.Text, T.Text)]
1966-
regExImports msg = result
1967-
where
1968-
parts = T.words msg
1969-
isPrefix = not . T.isPrefixOf "("
1970-
(mod, srcspan) = partition isPrefix parts
1971-
-- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))
1972-
result = if length mod == length srcspan then
1973-
regExPair `traverse` zip mod srcspan
1974-
else Nothing
1977+
regExImports msg
1978+
| Just mods' <- allMatchRegex msg "‘([^’]*)’"
1979+
, Just srcspans' <- allMatchRegex msg
1980+
#if MIN_VERSION_ghc(9,7,0)
1981+
"\\(at ([^)]*)\\)"
1982+
#else
1983+
"\\(([^)]*)\\)"
1984+
#endif
1985+
, mods <- [mod | [_,mod] <- mods']
1986+
, srcspans <- [srcspan | [_,srcspan] <- srcspans']
1987+
-- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))
1988+
, let result = if length mods == length srcspans then
1989+
Just (zip mods srcspans) else Nothing
1990+
= result
1991+
| otherwise = Nothing
19751992

19761993
matchRegExMultipleImports :: T.Text -> Maybe (T.Text, [(T.Text, T.Text)])
19771994
matchRegExMultipleImports message = do
1995+
#if MIN_VERSION_ghc(9,7,0)
1996+
let pat = T.pack "Add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
1997+
#else
19781998
let pat = T.pack "Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
1999+
#endif
19792000
(binding, imports) <- case matchRegexUnifySpaces message pat of
19802001
Just [x, xs] -> Just (x, xs)
19812002
_ -> Nothing

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

Lines changed: 29 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,13 @@ extendImportTopLevel thing (L l it@ImportDecl{..})
253253
noExtField
254254
#endif
255255
rdr
256-
x = reLocA $ L top $ IEVar noExtField lie
256+
x = reLocA $ L top $ IEVar
257+
#if MIN_VERSION_ghc(9,8,0)
258+
Nothing -- no deprecated
259+
#else
260+
noExtField
261+
#endif
262+
lie
257263

258264
if x `elem` lies
259265
then TransformT $ lift (Left $ thing <> " already imported")
@@ -311,7 +317,13 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
311317
noExtField
312318
#endif
313319
childRdr
314-
x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE]
320+
x :: LIE GhcPs = L ll' $ IEThingWith
321+
#if MIN_VERSION_ghc(9,7,0)
322+
(Nothing, addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments)
323+
#else
324+
(addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments)
325+
#endif
326+
absIE NoIEWildcard [childLIE]
315327

316328
#if MIN_VERSION_ghc(9,5,0)
317329
return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)}
@@ -329,7 +341,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
329341
let it' = it{ideclHiding = Just (hide, lies)}
330342
#endif
331343
thing = IEThingWith newl twIE (IEWildcard 2) []
344+
#if MIN_VERSION_ghc(9,7,0)
345+
newl = fmap (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l'''
346+
#else
332347
newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l'''
348+
#endif
333349
lies = L l' $ reverse pre ++ [L l'' thing] ++ xs
334350
return $ L l it'
335351
| parent == unIEWrappedName ie
@@ -382,7 +398,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
382398
noExtField
383399
#endif
384400
childRdr
401+
#if MIN_VERSION_ghc(9,5,0)
402+
listAnn = (Nothing, epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)])
403+
#else
385404
listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]
405+
#endif
386406
x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]
387407

388408
lies' = addCommaInImportList (reverse pre) x
@@ -486,7 +506,13 @@ extendHiding symbol (L l idecls) mlies df = do
486506
noExtField
487507
#endif
488508
rdr
489-
x = reLocA $ L top $ IEVar noExtField lie
509+
x = reLocA $ L top $ IEVar
510+
#if MIN_VERSION_ghc(9,7,0)
511+
Nothing
512+
#else
513+
noExtField
514+
#endif
515+
lie
490516
x <- pure $ if hasSibling then first addComma x else x
491517
lies <- pure $ over _head (`setEntryDP` SameLine 1) lies
492518
#if MIN_VERSION_ghc(9,5,0)

‎plugins/hls-refactor-plugin/test/Main.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -703,7 +703,11 @@ typeWildCardActionTests = testGroup "type wildcard actions"
703703
[ "func :: _"
704704
, "func x y = x + y"
705705
]
706+
#if MIN_VERSION_ghc(9,7,0)
707+
[ "func :: a -> a -> a" -- 9.8 has a different suggestion
708+
#else
706709
[ "func :: Integer -> Integer -> Integer"
710+
#endif
707711
, "func x y = x + y"
708712
]
709713
, testUseTypeSignature "type in parentheses"
@@ -731,7 +735,11 @@ typeWildCardActionTests = testGroup "type wildcard actions"
731735
[ "func::_"
732736
, "func x y = x + y"
733737
]
738+
#if MIN_VERSION_ghc(9,7,0)
739+
[ "func::a -> a -> a" -- 9.8 has a different suggestion
740+
#else
734741
[ "func::Integer -> Integer -> Integer"
742+
#endif
735743
, "func x y = x + y"
736744
]
737745
, testGroup "add parens if hole is part of bigger type"

0 commit comments

Comments
 (0)