Skip to content

Commit 0986598

Browse files
GuillaumedeVolpianoGuillaumedeVolpiano
committed
porting hls-refactor to ghc-9.12
1 parent 32f7800 commit 0986598

File tree

6 files changed

+164
-32
lines changed

6 files changed

+164
-32
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,12,0)
110+
import GHC.Types.SrcLoc (SrcSpan(..), 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,12,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,12,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,12,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,12,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,12,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,12,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)) }
812838
addParens True NameAnnTrailing{..} =
813-
NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..}
839+
NameAnn{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)), nann_name = epl 0, ..}
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 }
847+
addParens True NameAnnTrailing{..} =
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: 52 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -69,8 +69,7 @@ import Development.IDE.Types.Diagnostics
6969
import Development.IDE.Types.Exports
7070
import Development.IDE.Types.Location
7171
import Development.IDE.Types.Options
72-
import GHC (AddEpAnn (AddEpAnn),
73-
AnnsModule (am_main),
72+
import GHC (
7473
DeltaPos (..),
7574
EpAnn (..),
7675
LEpaComment)
@@ -105,17 +104,30 @@ import Text.Regex.TDFA ((=~), (=~~))
105104

106105
#if !MIN_VERSION_ghc(9,9,0)
107106
import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst)
108-
import GHC (Anchor (anchor_op),
107+
import GHC (AddEpAnn (AddEpAnn),
108+
AnnsModule (am_main),
109+
Anchor (anchor_op),
109110
AnchorOperation (..),
110111
EpaLocation (..))
111112
#endif
112113

113-
#if MIN_VERSION_ghc(9,9,0)
114-
import GHC (EpaLocation,
114+
#if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0)
115+
import GHC (AddEpAnn (AddEpAnn),
116+
AnnsModule (am_main),
117+
EpaLocation,
115118
EpaLocation' (..),
116119
HasLoc (..))
117120
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
118121
#endif
122+
#if MIN_VERSION_ghc(9,11,0)
123+
import GHC (EpaLocation,
124+
AnnsModule (am_where),
125+
EpaLocation' (..),
126+
HasLoc (..),
127+
EpToken (..))
128+
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
129+
#endif
130+
119131

120132
-------------------------------------------------------------------------------------------------
121133

@@ -339,7 +351,11 @@ findSigOfBinds range = go
339351
case unLoc <$> findDeclContainingLoc (_start range) lsigs of
340352
Just sig' -> Just sig'
341353
Nothing -> do
354+
#if MIN_VERSION_ghc(9,11,0)
355+
lHsBindLR <- findDeclContainingLoc (_start range) binds
356+
#else
342357
lHsBindLR <- findDeclContainingLoc (_start range) (bagToList binds)
358+
#endif
343359
findSigOfBind range (unLoc lHsBindLR)
344360
go _ = Nothing
345361

@@ -420,7 +436,11 @@ isUnusedImportedId
420436
modName
421437
importSpan
422438
| occ <- mkVarOcc identifier,
439+
#if MIN_VERSION_ghc(9,11,0)
440+
impModsVals <- importedByUser . concat $ imp_mods,
441+
#else
423442
impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,
443+
#endif
424444
Just rdrEnv <-
425445
listToMaybe
426446
[ imv_all_exports
@@ -659,7 +679,11 @@ suggestDeleteUnusedBinding
659679
name
660680
(L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do
661681
let go bag lsigs =
682+
#if MIN_VERSION_ghc(9,11,0)
683+
if null bag
684+
#else
662685
if isEmptyBag bag
686+
#endif
663687
then []
664688
else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag
665689
case grhssLocalBinds of
@@ -1700,13 +1724,22 @@ findPositionAfterModuleName ps _hsmodName' = do
17001724
#endif
17011725
EpAnn _ annsModule _ -> do
17021726
-- Find the first 'where'
1727+
#if MIN_VERSION_ghc(9,11,0)
1728+
whereLocation <- filterWhere $ am_where annsModule
1729+
#else
17031730
whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule
1731+
#endif
17041732
epaLocationToLine whereLocation
17051733
#if !MIN_VERSION_ghc(9,9,0)
17061734
EpAnnNotUsed -> Nothing
17071735
#endif
1736+
#if MIN_VERSION_ghc(9,11,0)
1737+
filterWhere (EpTok loc) = Just loc
1738+
filterWhere _ = Nothing
1739+
#else
17081740
filterWhere (AddEpAnn AnnWhere loc) = Just loc
17091741
filterWhere _ = Nothing
1742+
#endif
17101743

17111744
epaLocationToLine :: EpaLocation -> Maybe Int
17121745
#if MIN_VERSION_ghc(9,9,0)
@@ -1719,20 +1752,32 @@ findPositionAfterModuleName ps _hsmodName' = do
17191752
epaLocationToLine (EpaSpan sp)
17201753
= Just . srcLocLine . realSrcSpanEnd $ sp
17211754
#endif
1755+
#if MIN_VERSION_ghc(9,11,0)
1756+
epaLocationToLine (EpaDelta _ (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
1757+
-- 'priorComments' contains the comments right before the current EpaLocation
1758+
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
1759+
-- the current AST node
1760+
epaLocationToLine (EpaDelta _ (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1761+
#else
17221762
epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
17231763
-- 'priorComments' contains the comments right before the current EpaLocation
17241764
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
17251765
-- the current AST node
17261766
epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1727-
1767+
#endif
17281768
sumCommentsOffset :: [LEpaComment] -> Int
17291769
#if MIN_VERSION_ghc(9,9,0)
17301770
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine anchor)
17311771
#else
17321772
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor))
17331773
#endif
17341774

1735-
#if MIN_VERSION_ghc(9,9,0)
1775+
#if MIN_VERSION_ghc(9,11,0)
1776+
anchorOpLine :: EpaLocation' a -> Int
1777+
anchorOpLine EpaSpan{} = 0
1778+
anchorOpLine (EpaDelta _ (SameLine _) _) = 0
1779+
anchorOpLine (EpaDelta _ (DifferentLine line _) _) = line
1780+
#elif MIN_VERSION_ghc(9,9,0)
17361781
anchorOpLine :: EpaLocation' a -> Int
17371782
anchorOpLine EpaSpan{} = 0
17381783
anchorOpLine (EpaDelta (SameLine _) _) = 0

0 commit comments

Comments
 (0)