porting hls-refactor to ghc-9.12

.github/workflows/test.yml

@@ -134,7 +134,7 @@ jobs:
           HLS_WRAPPER_TEST_EXE: hls-wrapper
         run: cabal test wrapper-test
 
-      - if: matrix.test && matrix.ghc != '9.12'
+      - if: matrix.test
         name: Test hls-refactor-plugin
         run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests
 
@@ -185,7 +185,7 @@ jobs:
         name: Test hls-call-hierarchy-plugin test suite
         run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests
 
-      - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.12'
+      - if: matrix.test && matrix.os != 'windows-latest'
         name: Test hls-rename-plugin test suite
         run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests
 

haskell-language-server.cabal

@@ -580,13 +580,13 @@ flag rename
   manual:      True
 
 common rename
-  if flag(rename) && (impl(ghc < 9.11) || flag(ignore-plugins-ghc-bounds))
+  if flag(rename)
     build-depends: haskell-language-server:hls-rename-plugin
     cpp-options: -Dhls_rename
 
 library hls-rename-plugin
   import:           defaults, pedantic, warnings
-  if !flag(rename) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
+  if !flag(rename)
     buildable: False
   exposed-modules:  Ide.Plugin.Rename
   hs-source-dirs:   plugins/hls-rename-plugin/src
@@ -610,7 +610,7 @@ library hls-rename-plugin
 
 test-suite hls-rename-plugin-tests
   import:           defaults, pedantic, test-defaults, warnings
-  if !flag(rename) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
+  if !flag(rename)
     buildable: False
   type:             exitcode-stdio-1.0
   hs-source-dirs:   plugins/hls-rename-plugin/test
@@ -1596,13 +1596,13 @@ flag refactor
   manual:      True
 
 common refactor
-  if flag(refactor) && (impl(ghc < 9.11) || flag(ignore-plugins-ghc-bounds))
+  if flag(refactor) 
     build-depends: haskell-language-server:hls-refactor-plugin
     cpp-options: -Dhls_refactor
 
 library hls-refactor-plugin
   import:           defaults, pedantic, warnings
-  if !flag(refactor) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
+  if !flag(refactor)
     buildable: False
   exposed-modules:  Development.IDE.GHC.ExactPrint
                     Development.IDE.GHC.Compat.ExactPrint
@@ -1661,7 +1661,7 @@ library hls-refactor-plugin
 
 test-suite hls-refactor-plugin-tests
   import:           defaults, pedantic, test-defaults, warnings
-  if !flag(refactor) || (impl(ghc > 9.11) && !flag(ignore-plugins-ghc-bounds))
+  if !flag(refactor)
     buildable: False
   type:             exitcode-stdio-1.0
   hs-source-dirs:   plugins/hls-refactor-plugin/test

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

@@ -106,6 +106,9 @@ import           GHC.Parser.Annotation                   (AnnContext (..),
                                                           deltaPos)
 import           GHC.Types.SrcLoc                        (generatedSrcSpan)
 #endif
+#if MIN_VERSION_ghc(9,11,0)
+import           GHC.Types.SrcLoc (UnhelpfulSpanReason(..))
+#endif
 
 #if MIN_VERSION_ghc(9,9,0)
 import           GHC                                     (
@@ -116,6 +119,9 @@ import           GHC                                     (
                                                           EpAnn (..),
                                                           EpaLocation,
                                                           EpaLocation' (..),
+#if MIN_VERSION_ghc(9,11,0)
+                                                          EpToken (..),
+#endif
                                                           NameAdornment (..),
                                                           NameAnn (..),
                                                           SrcSpanAnnA,
@@ -124,7 +130,6 @@ import           GHC                                     (
                                                           emptyComments,
                                                           spanAsAnchor)
 #endif
-
 setPrecedingLines ::
 #if !MIN_VERSION_ghc(9,9,0)
      Default t =>
@@ -168,6 +173,10 @@ annotateParsedSource (ParsedModule _ ps _) =
     (makeDeltaAst ps)
 #endif
 
+#if MIN_VERSION_ghc(9,11,0)
+type Anchor = EpaLocation
+#endif
+
 ------------------------------------------------------------------------------
 
 {- | A transformation for grafting source trees together. Use the semigroup
@@ -466,7 +475,10 @@ modifySmallestDeclWithM validSpan f a = do
             False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest
   modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a
 
-#if MIN_VERSION_ghc(9,9,0)
+#if MIN_VERSION_ghc(9,11,0)
+generatedAnchor :: DeltaPos -> Anchor
+generatedAnchor dp = EpaDelta (UnhelpfulSpan UnhelpfulNoLocationInfo) dp []
+#elif MIN_VERSION_ghc(9,9,0)
 generatedAnchor :: DeltaPos -> Anchor
 generatedAnchor dp = EpaDelta dp []
 #else
@@ -766,15 +778,28 @@ eqSrcSpan l r = leftmost_smallest l r == EQ
 addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
 addParensToCtxt close_dp = addOpen . addClose
   where
+#if MIN_VERSION_ghc(9,11,0)
+      addOpen it@AnnContext{ac_open = []} = it{ac_open = [EpTok (epl 0)]}
+#else
       addOpen it@AnnContext{ac_open = []} = it{ac_open = [epl 0]}
+#endif
       addOpen other                       = other
       addClose it
+#if MIN_VERSION_ghc(9,11,0)
+        | Just c <- close_dp = it{ac_close = [EpTok c]}
+        | AnnContext{ac_close = []} <- it = it{ac_close = [EpTok (epl 0)]}
+#else
         | Just c <- close_dp = it{ac_close = [c]}
         | AnnContext{ac_close = []} <- it = it{ac_close = [epl 0]}
+#endif
         | otherwise = it
 
 epl :: Int -> EpaLocation
+#if MIN_VERSION_ghc(9,11,0)
+epl n = EpaDelta (UnhelpfulSpan UnhelpfulNoLocationInfo) (SameLine n) []
+#else
 epl n = EpaDelta (SameLine n) []
+#endif
 
 epAnn :: SrcSpan -> ann -> EpAnn ann
 epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments
@@ -803,14 +828,25 @@ removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)
 #endif
 
 addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
+#if MIN_VERSION_ghc(9,11,0)
 addParens True it@NameAnn{} =
-        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
+        it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
 addParens True it@NameAnnCommas{} =
-        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
+        it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
 addParens True it@NameAnnOnly{} =
-        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
+        it{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)) }
+addParens True it@NameAnnTrailing{} =
+  NameAnn{nann_adornment = NameParens (EpTok (epl 0)) (EpTok (epl 0)), nann_name = epl 0, nann_trailing = nann_trailing it}
+#else
+addParens True it@NameAnn{} =
+        it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
+addParens True it@NameAnnCommas{} =
+        it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
+addParens True it@NameAnnOnly{} =
+        it{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0 }
 addParens True NameAnnTrailing{..} =
-        NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..}
+        NameAnn{nann_adornment = NameParens, nann_open=epl 0, nann_close=epl 0, nann_name = epl 0, ..}
+#endif
 addParens _ it = it
 
 removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast

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

@@ -50,7 +50,9 @@ import           Development.IDE.Core.Service
 import           Development.IDE.Core.Shake                        hiding (Log)
 import           Development.IDE.GHC.Compat                        hiding
                                                                    (ImplicitPrelude)
+#if !MIN_VERSION_ghc(9,11,0)
 import           Development.IDE.GHC.Compat.Util
+#endif
 import           Development.IDE.GHC.Error
 import           Development.IDE.GHC.ExactPrint
 import qualified Development.IDE.GHC.ExactPrint                    as E
@@ -71,8 +73,7 @@ import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
-import           GHC                                               (AddEpAnn (AddEpAnn),
-                                                                    AnnsModule (am_main),
+import           GHC                                               (
                                                                     DeltaPos (..),
                                                                     EpAnn (..),
                                                                     LEpaComment)
@@ -107,17 +108,30 @@ import           Text.Regex.TDFA                                   ((=~), (=~~))
 
 #if !MIN_VERSION_ghc(9,9,0)
 import           Development.IDE.GHC.Compat.ExactPrint             (makeDeltaAst)
-import           GHC                                               (Anchor (anchor_op),
+import           GHC                                               (AddEpAnn (AddEpAnn),
+                                                                    AnnsModule (am_main),
+                                                                    Anchor (anchor_op),
                                                                     AnchorOperation (..),
                                                                     EpaLocation (..))
 #endif
 
-#if MIN_VERSION_ghc(9,9,0)
-import           GHC                                               (EpaLocation,
+#if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0)
+import           GHC                                               (AddEpAnn (AddEpAnn),
+                                                                    AnnsModule (am_main),
+                                                                    EpaLocation,
                                                                     EpaLocation' (..),
                                                                     HasLoc (..))
 import           GHC.Types.SrcLoc                                  (srcSpanToRealSrcSpan)
 #endif
+#if MIN_VERSION_ghc(9,11,0)
+import           GHC                                               (EpaLocation,
+                                                                    AnnsModule (am_where),
+                                                                    EpaLocation' (..),
+                                                                    HasLoc (..),
+                                                                    EpToken (..))
+import           GHC.Types.SrcLoc                                  (srcSpanToRealSrcSpan)
+#endif
+
 
 -------------------------------------------------------------------------------------------------
 
@@ -341,7 +355,11 @@ findSigOfBinds range = go
         case unLoc <$> findDeclContainingLoc (_start range) lsigs of
           Just sig' -> Just sig'
           Nothing -> do
+#if MIN_VERSION_ghc(9,11,0)
+            lHsBindLR <- findDeclContainingLoc (_start range) binds
+#else
             lHsBindLR <- findDeclContainingLoc (_start range) (bagToList binds)
+#endif
             findSigOfBind range (unLoc lHsBindLR)
     go _ = Nothing
 
@@ -422,7 +440,11 @@ isUnusedImportedId
   modName
   importSpan
     | occ <- mkVarOcc identifier,
+#if MIN_VERSION_ghc(9,11,0)
+      impModsVals <- importedByUser . concat $ M.elems imp_mods,
+#else
       impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,
+#endif
       Just rdrEnv <-
         listToMaybe
           [ imv_all_exports
@@ -661,7 +683,11 @@ suggestDeleteUnusedBinding
         name
         (L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do
         let go bag lsigs =
+#if MIN_VERSION_ghc(9,11,0)
+                if null bag
+#else
                 if isEmptyBag bag
+#endif
                 then []
                 else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag
         case grhssLocalBinds of
@@ -1723,13 +1749,22 @@ findPositionAfterModuleName ps _hsmodName' = do
 #endif
         EpAnn _ annsModule _ -> do
             -- Find the first 'where'
+#if MIN_VERSION_ghc(9,11,0)
+            whereLocation <- filterWhere $ am_where annsModule
+#else
             whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule
+#endif
             epaLocationToLine whereLocation
 #if !MIN_VERSION_ghc(9,9,0)
         EpAnnNotUsed -> Nothing
 #endif
+#if MIN_VERSION_ghc(9,11,0)
+    filterWhere (EpTok loc) = Just loc
+    filterWhere _ = Nothing
+#else
     filterWhere (AddEpAnn AnnWhere loc) = Just loc
     filterWhere _                       = Nothing
+#endif
 
     epaLocationToLine :: EpaLocation -> Maybe Int
 #if MIN_VERSION_ghc(9,9,0)
@@ -1742,20 +1777,32 @@ findPositionAfterModuleName ps _hsmodName' = do
     epaLocationToLine (EpaSpan sp)
       = Just . srcLocLine . realSrcSpanEnd $ sp
 #endif
+#if MIN_VERSION_ghc(9,11,0)
+    epaLocationToLine (EpaDelta _ (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
+    -- 'priorComments' contains the comments right before the current EpaLocation
+    -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
+    -- the current AST node
+    epaLocationToLine (EpaDelta _ (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
+#else
     epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments
     -- 'priorComments' contains the comments right before the current EpaLocation
     -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
     -- the current AST node
     epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)
-
+#endif
     sumCommentsOffset :: [LEpaComment] -> Int
 #if MIN_VERSION_ghc(9,9,0)
     sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine anchor)
 #else
     sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor))
 #endif
 
-#if MIN_VERSION_ghc(9,9,0)
+#if MIN_VERSION_ghc(9,11,0)
+    anchorOpLine :: EpaLocation' a -> Int
+    anchorOpLine EpaSpan{}                           = 0
+    anchorOpLine (EpaDelta _ (SameLine _) _)           = 0
+    anchorOpLine (EpaDelta _ (DifferentLine line _) _) = line
+#elif MIN_VERSION_ghc(9,9,0)
     anchorOpLine :: EpaLocation' a -> Int
     anchorOpLine EpaSpan{}                           = 0
     anchorOpLine (EpaDelta (SameLine _) _)           = 0
@@ -1936,14 +1983,11 @@ extractQualifiedModuleName x
 --         ‘Data.Functor’ nor ‘Data.Text’ exports ‘putStrLn’.
 extractDoesNotExportModuleName :: T.Text -> Maybe T.Text
 extractDoesNotExportModuleName x
-  | Just [m] <-
-#if MIN_VERSION_ghc(9,4,0)
-    matchRegexUnifySpaces x "the module ‘([^’]*)’ does not export"
-      <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
-#else
-    matchRegexUnifySpaces x "Module ‘([^’]*)’ does not export"
-      <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ exports"
-#endif
+  | Just [m] <- case ghcVersion of
+                  GHC912 -> matchRegexUnifySpaces x "The module ‘([^’]*)’ does not export"
+                            <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
+                  _ ->      matchRegexUnifySpaces x "the module ‘([^’]*)’ does not export"
+                            <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
   = Just m
   | otherwise
   = Nothing