Skip to content

Commit cdcd99c

Browse files
GuillaumedeVolpianoGuillaumedeVolpiano
committed
porting hls-refactor to ghc-9.12
1 parent f1511ba commit cdcd99c

File tree

10 files changed

+248
-43
lines changed

10 files changed

+248
-43
lines changed

‎.github/workflows/test.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,7 @@ jobs:
134134
HLS_WRAPPER_TEST_EXE: hls-wrapper
135135
run: cabal test wrapper-test
136136

137-
- if: matrix.test && matrix.ghc != '9.12'
137+
- if: matrix.test
138138
name: Test hls-refactor-plugin
139139
run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests
140140

‎haskell-language-server.cabal

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -580,13 +580,13 @@ flag rename
580580
manual: True
581581

582582
common rename
583-
if flag(rename) && (impl(ghc < 9.11) || flag(ignore-plugins-ghc-bounds))
583+
if flag(rename)
584584
build-depends: haskell-language-server:hls-rename-plugin
585585
cpp-options: -Dhls_rename
586586

587587
library hls-rename-plugin
588588
import: defaults, pedantic, warnings
589-
if !flag(rename) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
589+
if !flag(rename)
590590
buildable: False
591591
exposed-modules: Ide.Plugin.Rename
592592
hs-source-dirs: plugins/hls-rename-plugin/src
@@ -610,7 +610,7 @@ library hls-rename-plugin
610610

611611
test-suite hls-rename-plugin-tests
612612
import: defaults, pedantic, test-defaults, warnings
613-
if !flag(rename) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
613+
if !flag(rename)
614614
buildable: False
615615
type: exitcode-stdio-1.0
616616
hs-source-dirs: plugins/hls-rename-plugin/test
@@ -932,13 +932,13 @@ flag splice
932932
manual: True
933933

934934
common splice
935-
if flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))
935+
if flag(splice)
936936
build-depends: haskell-language-server:hls-splice-plugin
937937
cpp-options: -Dhls_splice
938938

939939
library hls-splice-plugin
940940
import: defaults, pedantic, warnings
941-
if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
941+
if !flag(splice)
942942
buildable: False
943943
exposed-modules:
944944
Ide.Plugin.Splice
@@ -966,7 +966,7 @@ library hls-splice-plugin
966966

967967
test-suite hls-splice-plugin-tests
968968
import: defaults, pedantic, test-defaults, warnings
969-
if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
969+
if !flag(splice)
970970
buildable: False
971971
type: exitcode-stdio-1.0
972972
hs-source-dirs: plugins/hls-splice-plugin/test
@@ -1596,13 +1596,13 @@ flag refactor
15961596
manual: True
15971597

15981598
common refactor
1599-
if flag(refactor) && (impl(ghc < 9.11) || flag(ignore-plugins-ghc-bounds))
1599+
if flag(refactor)
16001600
build-depends: haskell-language-server:hls-refactor-plugin
16011601
cpp-options: -Dhls_refactor
16021602

16031603
library hls-refactor-plugin
16041604
import: defaults, pedantic, warnings
1605-
if !flag(refactor) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
1605+
if !flag(refactor)
16061606
buildable: False
16071607
exposed-modules: Development.IDE.GHC.ExactPrint
16081608
Development.IDE.GHC.Compat.ExactPrint
@@ -1661,7 +1661,7 @@ library hls-refactor-plugin
16611661

16621662
test-suite hls-refactor-plugin-tests
16631663
import: defaults, pedantic, test-defaults, warnings
1664-
if !flag(refactor) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
1664+
if !flag(refactor)
16651665
buildable: False
16661666
type: exitcode-stdio-1.0
16671667
hs-source-dirs: plugins/hls-refactor-plugin/test

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

Lines changed: 42 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,9 @@ import GHC.Parser.Annotation (AnnContext (..),
106106
deltaPos)
107107
import GHC.Types.SrcLoc (generatedSrcSpan)
108108
#endif
109+
#if MIN_VERSION_ghc(9,11,0)
110+
import GHC.Types.SrcLoc (UnhelpfulSpanReason(..))
111+
#endif
109112

110113
#if MIN_VERSION_ghc(9,9,0)
111114
import GHC (
@@ -116,6 +119,9 @@ import GHC (
116119
EpAnn (..),
117120
EpaLocation,
118121
EpaLocation' (..),
122+
#if MIN_VERSION_ghc(9,11,0)
123+
EpToken (..),
124+
#endif
119125
NameAdornment (..),
120126
NameAnn (..),
121127
SrcSpanAnnA,
@@ -124,7 +130,6 @@ import GHC (
124130
emptyComments,
125131
spanAsAnchor)
126132
#endif
127-
128133
setPrecedingLines ::
129134
#if !MIN_VERSION_ghc(9,9,0)
130135
Default t =>
@@ -168,6 +173,10 @@ annotateParsedSource (ParsedModule _ ps _) =
168173
(makeDeltaAst ps)
169174
#endif
170175

176+
#if MIN_VERSION_ghc(9,11,0)
177+
type Anchor = EpaLocation
178+
#endif
179+
171180
------------------------------------------------------------------------------
172181

173182
{- | A transformation for grafting source trees together. Use the semigroup
@@ -466,7 +475,10 @@ modifySmallestDeclWithM validSpan f a = do
466475
False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest
467476
modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a
468477

469-
#if MIN_VERSION_ghc(9,9,0)
478+
#if MIN_VERSION_ghc(9,11,0)
479+
generatedAnchor :: DeltaPos -> Anchor
480+
generatedAnchor dp = EpaDelta (UnhelpfulSpan UnhelpfulNoLocationInfo) dp []
481+
#elif MIN_VERSION_ghc(9,9,0)
470482
generatedAnchor :: DeltaPos -> Anchor
471483
generatedAnchor dp = EpaDelta dp []
472484
#else
@@ -766,15 +778,28 @@ eqSrcSpan l r = leftmost_smallest l r == EQ
766778
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
767779
addParensToCtxt close_dp = addOpen . addClose
768780
where
781+
#if MIN_VERSION_ghc(9,11,0)
782+
addOpen it@AnnContext{ac_open = []} = it{ac_open = [EpTok (epl 0)]}
783+
#else
769784
addOpen it@AnnContext{ac_open = []} = it{ac_open = [epl 0]}
785+
#endif
770786
addOpen other = other
771787
addClose it
788+
#if MIN_VERSION_ghc(9,11,0)
789+
| Just c <- close_dp = it{ac_close = [EpTok c]}
790+
| AnnContext{ac_close = []} <- it = it{ac_close = [EpTok (epl 0)]}
791+
#else
772792
| Just c <- close_dp = it{ac_close = [c]}
773793
| AnnContext{ac_close = []} <- it = it{ac_close = [epl 0]}
794+
#endif
774795
| otherwise = it
775796

776797
epl :: Int -> EpaLocation
798+
#if MIN_VERSION_ghc(9,11,0)
799+
epl n = EpaDelta (UnhelpfulSpan UnhelpfulNoLocationInfo) (SameLine n) []
800+
#else
777801
epl n = EpaDelta (SameLine n) []
802+
#endif
778803

779804
epAnn :: SrcSpan -> ann -> EpAnn ann
780805
epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments
@@ -803,14 +828,25 @@ removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)
803828
#endif
804829

805830
addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
831+
#if MIN_VERSION_ghc(9,11,0)
806832
addParens True it@NameAnn{} =
807-
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
833+
it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
808834
addParens True it@NameAnnCommas{} =
809-
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
835+
it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
810836
addParens True it@NameAnnOnly{} =
811-
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
837+
it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
838+
addParens True it@NameAnnTrailing{} =
839+
NameAnn{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)), nann_name = epl 0, nann_trailing = nann_trailing it}
840+
#else
841+
addParens True it@NameAnn{} =
842+
it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
843+
addParens True it@NameAnnCommas{} =
844+
it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
845+
addParens True it@NameAnnOnly{} =
846+
it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
812847
addParens True NameAnnTrailing{..} =
813-
NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..}
848+
NameAnn{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0, nann_name = epl 0, ..}
849+
#endif
814850
addParens _ it = it
815851

816852
removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast

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

Lines changed: 58 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,9 @@ import Development.IDE.Core.Service
5050
import Development.IDE.Core.Shake hiding (Log)
5151
import Development.IDE.GHC.Compat hiding
5252
(ImplicitPrelude)
53+
#if !MIN_VERSION_ghc(9,11,0)
5354
import Development.IDE.GHC.Compat.Util
55+
#endif
5456
import Development.IDE.GHC.Error
5557
import Development.IDE.GHC.ExactPrint
5658
import qualified Development.IDE.GHC.ExactPrint as E
@@ -71,8 +73,7 @@ import Development.IDE.Types.Diagnostics
7173
import Development.IDE.Types.Exports
7274
import Development.IDE.Types.Location
7375
import Development.IDE.Types.Options
74-
import GHC (AddEpAnn (AddEpAnn),
75-
AnnsModule (am_main),
76+
import GHC (
7677
DeltaPos (..),
7778
EpAnn (..),
7879
LEpaComment)
@@ -107,17 +108,30 @@ import Text.Regex.TDFA ((=~), (=~~))
107108

108109
#if !MIN_VERSION_ghc(9,9,0)
109110
import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst)
110-
import GHC (Anchor (anchor_op),
111+
import GHC (AddEpAnn (AddEpAnn),
112+
AnnsModule (am_main),
113+
Anchor (anchor_op),
111114
AnchorOperation (..),
112115
EpaLocation (..))
113116
#endif
114117

115-
#if MIN_VERSION_ghc(9,9,0)
116-
import GHC (EpaLocation,
118+
#if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0)
119+
import GHC (AddEpAnn (AddEpAnn),
120+
AnnsModule (am_main),
121+
EpaLocation,
117122
EpaLocation' (..),
118123
HasLoc (..))
119124
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
120125
#endif
126+
#if MIN_VERSION_ghc(9,11,0)
127+
import GHC (EpaLocation,
128+
AnnsModule (am_where),
129+
EpaLocation' (..),
130+
HasLoc (..),
131+
EpToken (..))
132+
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
133+
#endif
134+
121135

122136
-------------------------------------------------------------------------------------------------
123137

@@ -341,7 +355,11 @@ findSigOfBinds range = go
341355
case unLoc <$> findDeclContainingLoc (_start range) lsigs of
342356
Just sig' -> Just sig'
343357
Nothing -> do
358+
#if MIN_VERSION_ghc(9,11,0)
359+
lHsBindLR <- findDeclContainingLoc (_start range) binds
360+
#else
344361
lHsBindLR <- findDeclContainingLoc (_start range) (bagToList binds)
362+
#endif
345363
findSigOfBind range (unLoc lHsBindLR)
346364
go _ = Nothing
347365

@@ -422,7 +440,11 @@ isUnusedImportedId
422440
modName
423441
importSpan
424442
| occ <- mkVarOcc identifier,
443+
#if MIN_VERSION_ghc(9,11,0)
444+
impModsVals <- importedByUser . concat $ M.elems imp_mods,
445+
#else
425446
impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,
447+
#endif
426448
Just rdrEnv <-
427449
listToMaybe
428450
[ imv_all_exports
@@ -661,7 +683,11 @@ suggestDeleteUnusedBinding
661683
name
662684
(L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do
663685
let go bag lsigs =
686+
#if MIN_VERSION_ghc(9,11,0)
687+
if null bag
688+
#else
664689
if isEmptyBag bag
690+
#endif
665691
then []
666692
else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag
667693
case grhssLocalBinds of
@@ -1723,13 +1749,22 @@ findPositionAfterModuleName ps _hsmodName' = do
17231749
#endif
17241750
EpAnn _ annsModule _ -> do
17251751
-- Find the first 'where'
1752+
#if MIN_VERSION_ghc(9,11,0)
1753+
whereLocation <- filterWhere $ am_where annsModule
1754+
#else
17261755
whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule
1756+
#endif
17271757
epaLocationToLine whereLocation
17281758
#if !MIN_VERSION_ghc(9,9,0)
17291759
EpAnnNotUsed -> Nothing
17301760
#endif
1761+
#if MIN_VERSION_ghc(9,11,0)
1762+
filterWhere (EpTok loc) = Just loc
1763+
filterWhere _ = Nothing
1764+
#else
17311765
filterWhere (AddEpAnn AnnWhere loc) = Just loc
17321766
filterWhere _ = Nothing
1767+
#endif
17331768

17341769
epaLocationToLine :: EpaLocation -> Maybe Int
17351770
#if MIN_VERSION_ghc(9,9,0)
@@ -1742,20 +1777,32 @@ findPositionAfterModuleName ps _hsmodName' = do
17421777
epaLocationToLine (EpaSpan sp)
17431778
= Just . srcLocLine . realSrcSpanEnd $ sp
17441779
#endif
1780+
#if MIN_VERSION_ghc(9,11,0)
1781+
epaLocationToLine (EpaDelta _ (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
1782+
-- 'priorComments' contains the comments right before the current EpaLocation
1783+
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
1784+
-- the current AST node
1785+
epaLocationToLine (EpaDelta _ (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1786+
#else
17451787
epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
17461788
-- 'priorComments' contains the comments right before the current EpaLocation
17471789
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
17481790
-- the current AST node
17491791
epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1750-
1792+
#endif
17511793
sumCommentsOffset :: [LEpaComment] -> Int
17521794
#if MIN_VERSION_ghc(9,9,0)
17531795
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine anchor)
17541796
#else
17551797
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor))
17561798
#endif
17571799

1758-
#if MIN_VERSION_ghc(9,9,0)
1800+
#if MIN_VERSION_ghc(9,11,0)
1801+
anchorOpLine :: EpaLocation' a -> Int
1802+
anchorOpLine EpaSpan{} = 0
1803+
anchorOpLine (EpaDelta _ (SameLine _) _) = 0
1804+
anchorOpLine (EpaDelta _ (DifferentLine line _) _) = line
1805+
#elif MIN_VERSION_ghc(9,9,0)
17591806
anchorOpLine :: EpaLocation' a -> Int
17601807
anchorOpLine EpaSpan{} = 0
17611808
anchorOpLine (EpaDelta (SameLine _) _) = 0
@@ -1937,7 +1984,10 @@ extractQualifiedModuleName x
19371984
extractDoesNotExportModuleName :: T.Text -> Maybe T.Text
19381985
extractDoesNotExportModuleName x
19391986
| Just [m] <-
1940-
#if MIN_VERSION_ghc(9,4,0)
1987+
#if MIN_VERSION_ghc(9,12,0)
1988+
matchRegexUnifySpaces x "The module ‘([^’]*)’ does not export"
1989+
<|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
1990+
#elif MIN_VERSION_ghc(9,4,0)
19411991
matchRegexUnifySpaces x "the module ‘([^’]*)’ does not export"
19421992
<|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
19431993
#else

0 commit comments

Comments
 (0)