Skip to content

Commit 6bf3945

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

File tree

9 files changed

+238
-38
lines changed

9 files changed

+238
-38
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: 52 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -71,8 +71,7 @@ import Development.IDE.Types.Diagnostics
7171
import Development.IDE.Types.Exports
7272
import Development.IDE.Types.Location
7373
import Development.IDE.Types.Options
74-
import GHC (AddEpAnn (AddEpAnn),
75-
AnnsModule (am_main),
74+
import GHC (
7675
DeltaPos (..),
7776
EpAnn (..),
7877
LEpaComment)
@@ -107,17 +106,30 @@ import Text.Regex.TDFA ((=~), (=~~))
107106

108107
#if !MIN_VERSION_ghc(9,9,0)
109108
import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst)
110-
import GHC (Anchor (anchor_op),
109+
import GHC (AddEpAnn (AddEpAnn),
110+
AnnsModule (am_main),
111+
Anchor (anchor_op),
111112
AnchorOperation (..),
112113
EpaLocation (..))
113114
#endif
114115

115-
#if MIN_VERSION_ghc(9,9,0)
116-
import GHC (EpaLocation,
116+
#if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0)
117+
import GHC (AddEpAnn (AddEpAnn),
118+
AnnsModule (am_main),
119+
EpaLocation,
117120
EpaLocation' (..),
118121
HasLoc (..))
119122
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
120123
#endif
124+
#if MIN_VERSION_ghc(9,11,0)
125+
import GHC (EpaLocation,
126+
AnnsModule (am_where),
127+
EpaLocation' (..),
128+
HasLoc (..),
129+
EpToken (..))
130+
import GHC.Types.SrcLoc (srcSpanToRealSrcSpan)
131+
#endif
132+
121133

122134
-------------------------------------------------------------------------------------------------
123135

@@ -341,7 +353,11 @@ findSigOfBinds range = go
341353
case unLoc <$> findDeclContainingLoc (_start range) lsigs of
342354
Just sig' -> Just sig'
343355
Nothing -> do
356+
#if MIN_VERSION_ghc(9,11,0)
357+
lHsBindLR <- findDeclContainingLoc (_start range) binds
358+
#else
344359
lHsBindLR <- findDeclContainingLoc (_start range) (bagToList binds)
360+
#endif
345361
findSigOfBind range (unLoc lHsBindLR)
346362
go _ = Nothing
347363

@@ -422,7 +438,11 @@ isUnusedImportedId
422438
modName
423439
importSpan
424440
| occ <- mkVarOcc identifier,
441+
#if MIN_VERSION_ghc(9,11,0)
442+
impModsVals <- importedByUser . concat $ M.elems imp_mods,
443+
#else
425444
impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,
445+
#endif
426446
Just rdrEnv <-
427447
listToMaybe
428448
[ imv_all_exports
@@ -661,7 +681,11 @@ suggestDeleteUnusedBinding
661681
name
662682
(L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do
663683
let go bag lsigs =
684+
#if MIN_VERSION_ghc(9,11,0)
685+
if null bag
686+
#else
664687
if isEmptyBag bag
688+
#endif
665689
then []
666690
else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag
667691
case grhssLocalBinds of
@@ -1723,13 +1747,22 @@ findPositionAfterModuleName ps _hsmodName' = do
17231747
#endif
17241748
EpAnn _ annsModule _ -> do
17251749
-- Find the first 'where'
1750+
#if MIN_VERSION_ghc(9,11,0)
1751+
whereLocation <- filterWhere $ am_where annsModule
1752+
#else
17261753
whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule
1754+
#endif
17271755
epaLocationToLine whereLocation
17281756
#if !MIN_VERSION_ghc(9,9,0)
17291757
EpAnnNotUsed -> Nothing
17301758
#endif
1759+
#if MIN_VERSION_ghc(9,11,0)
1760+
filterWhere (EpTok loc) = Just loc
1761+
filterWhere _ = Nothing
1762+
#else
17311763
filterWhere (AddEpAnn AnnWhere loc) = Just loc
17321764
filterWhere _ = Nothing
1765+
#endif
17331766

17341767
epaLocationToLine :: EpaLocation -> Maybe Int
17351768
#if MIN_VERSION_ghc(9,9,0)
@@ -1742,20 +1775,32 @@ findPositionAfterModuleName ps _hsmodName' = do
17421775
epaLocationToLine (EpaSpan sp)
17431776
= Just . srcLocLine . realSrcSpanEnd $ sp
17441777
#endif
1778+
#if MIN_VERSION_ghc(9,11,0)
1779+
epaLocationToLine (EpaDelta _ (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
1780+
-- 'priorComments' contains the comments right before the current EpaLocation
1781+
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
1782+
-- the current AST node
1783+
epaLocationToLine (EpaDelta _ (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1784+
#else
17451785
epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
17461786
-- 'priorComments' contains the comments right before the current EpaLocation
17471787
-- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
17481788
-- the current AST node
17491789
epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
1750-
1790+
#endif
17511791
sumCommentsOffset :: [LEpaComment] -> Int
17521792
#if MIN_VERSION_ghc(9,9,0)
17531793
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine anchor)
17541794
#else
17551795
sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor))
17561796
#endif
17571797

1758-
#if MIN_VERSION_ghc(9,9,0)
1798+
#if MIN_VERSION_ghc(9,11,0)
1799+
anchorOpLine :: EpaLocation' a -> Int
1800+
anchorOpLine EpaSpan{} = 0
1801+
anchorOpLine (EpaDelta _ (SameLine _) _) = 0
1802+
anchorOpLine (EpaDelta _ (DifferentLine line _) _) = line
1803+
#elif MIN_VERSION_ghc(9,9,0)
17591804
anchorOpLine :: EpaLocation' a -> Int
17601805
anchorOpLine EpaSpan{} = 0
17611806
anchorOpLine (EpaDelta (SameLine _) _) = 0

0 commit comments

Comments
 (0)