Reintroduce ghc-lib flag for hlint plugin (#3757)

* Remove bitrotted CPP gated code

A lot of the HLINT_ON_GHC_LIB gated code has been bitrotting since this
flag was removed. This could be reintroduced if we wanted to directly
work on the same parsed AST, but as the hlint ghc plugin showed this
may not make much difference: https://www.haskellforall.com/2023/09/ghc-plugin-for-hlint.html

* Reintroduce ghc-lib flag for hlint plugin

The ghc-lib flag was removed in #3015, but it's still useful to
be able to compile hls-hlint-plugin using the GHC API if you've done so
for hlint and ghc-lib-parser-ex, rather than using ghc-lib-parser as it
simplifies the build and dependencies.

Author: RaoulHC

haskell-language-server.cabal

@@ -593,6 +593,13 @@ test-suite hls-retrie-plugin-tests
 -- hlint plugin
 -----------------------------
 
+flag ghc-lib
+  description:
+    Use ghc-lib-parser rather than the ghc library (requires hlint and
+    ghc-lib-parser-ex to also be built with it)
+  default: True
+  manual: True
+
 flag hlint
   description: Enable hlint plugin
   default:     True
@@ -628,11 +635,17 @@ library hls-hlint-plugin
     , text
     , transformers
     , unordered-containers
-    , ghc-lib-parser
     , ghc-lib-parser-ex
     , apply-refact
 
-  cpp-options:   -DHLINT_ON_GHC_LIB
+  if flag(ghc-lib)
+    cpp-options:   -DGHC_LIB
+    build-depends:
+        ghc-lib-parser
+  else
+    build-depends:
+        ghc
+      , ghc-boot
 
   default-extensions:
     DataKinds

plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

@@ -18,7 +18,7 @@
 -- lots of CPP, we just disable the warning until later.
 {-# OPTIONS_GHC -Wno-redundant-constraints   #-}
 
-#ifdef HLINT_ON_GHC_LIB
+#ifdef GHC_LIB
 #define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib_parser(x,y,z)
 #else
 #define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z)
@@ -61,7 +61,6 @@ import           Development.IDE.Core.Shake                         (getDiagnost
 import qualified Refact.Apply                                       as Refact
 import qualified Refact.Types                                       as Refact
 
-#ifdef HLINT_ON_GHC_LIB
 import           Development.IDE.GHC.Compat                         (DynFlags,
                                                                      WarningFlag (Opt_WarnUnrecognisedPragmas),
                                                                      extensionFlags,
@@ -71,18 +70,18 @@ import           Development.IDE.GHC.Compat                         (DynFlags,
 import qualified Development.IDE.GHC.Compat.Util                    as EnumSet
 
 #if MIN_GHC_API_VERSION(9,4,0)
-import qualified "ghc-lib-parser" GHC.Data.Strict                   as Strict
+import qualified GHC.Data.Strict                                    as Strict
 #endif
 #if MIN_GHC_API_VERSION(9,0,0)
-import           "ghc-lib-parser" GHC.Types.SrcLoc                  hiding
+import           GHC.Types.SrcLoc                                   hiding
                                                                     (RealSrcSpan)
-import qualified "ghc-lib-parser" GHC.Types.SrcLoc                  as GHC
+import qualified GHC.Types.SrcLoc                                   as GHC
 #else
-import           "ghc-lib-parser" SrcLoc                            hiding
+import qualified SrcLoc                                             as GHC
+import           SrcLoc                                             hiding
                                                                     (RealSrcSpan)
-import qualified "ghc-lib-parser" SrcLoc                            as GHC
 #endif
-import           "ghc-lib-parser" GHC.LanguageExtensions            (Extension)
+import           GHC.LanguageExtensions                             (Extension)
 import           Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension)
 import           System.FilePath                                    (takeFileName)
 import           System.IO                                          (IOMode (WriteMode),
@@ -94,21 +93,7 @@ import           System.IO                                          (IOMode (Wri
                                                                      utf8,
                                                                      withFile)
 import           System.IO.Temp
-#else
-import           Development.IDE.GHC.Compat                         hiding
-                                                                    (setEnv,
-                                                                     (<+>))
-import           GHC.Generics                                       (Associativity (LeftAssociative, NotAssociative, RightAssociative))
-#if MIN_GHC_API_VERSION(9,2,0)
-import           Language.Haskell.GHC.ExactPrint.ExactPrint         (deltaOptions)
-#else
-import           Language.Haskell.GHC.ExactPrint.Delta              (deltaOptions)
-#endif
-import           Language.Haskell.GHC.ExactPrint.Parsers            (postParseTransform)
-import           Language.Haskell.GHC.ExactPrint.Types              (Rigidity (..))
-import           Language.Haskell.GhclibParserEx.Fixity             as GhclibParserEx (applyFixities)
-import qualified Refact.Fixity                                      as Refact
-#endif
+
 import           Ide.Plugin.Config                                  hiding
                                                                     (Config)
 import           Ide.Plugin.Error
@@ -159,7 +144,6 @@ instance Pretty Log where
     LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
     LogResolve msg -> pretty msg
 
-#ifdef HLINT_ON_GHC_LIB
 -- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib
 #if !MIN_GHC_API_VERSION(9,0,0)
 type BufSpan = ()
@@ -173,7 +157,6 @@ pattern RealSrcSpan x y = GHC.RealSrcSpan x y
 pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y))
 #endif
 {-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
-#endif
 
 #if MIN_GHC_API_VERSION(9,4,0)
 fromStrictMaybe :: Strict.Maybe a -> Maybe a
@@ -316,28 +299,6 @@ getIdeas recorder nfp = do
   fmap applyHints' (moduleEx flags)
 
   where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx))
-#ifndef HLINT_ON_GHC_LIB
-        moduleEx _flags = do
-          mbpm <- getParsedModuleWithComments nfp
-          return $ createModule <$> mbpm
-          where
-            createModule pm = Right (createModuleEx anns (applyParseFlagsFixities modu))
-                  where anns = pm_annotations pm
-                        modu = pm_parsed_source pm
-
-            applyParseFlagsFixities :: ParsedSource -> ParsedSource
-            applyParseFlagsFixities modul = GhclibParserEx.applyFixities (parseFlagsToFixities _flags) modul
-
-            parseFlagsToFixities :: ParseFlags -> [(String, Fixity)]
-            parseFlagsToFixities = map toFixity . Hlint.fixities
-
-            toFixity :: FixityInfo -> (String, Fixity)
-            toFixity (name, dir, i) = (name, Fixity NoSourceText i $ f dir)
-                where
-                    f LeftAssociative  = InfixL
-                    f RightAssociative = InfixR
-                    f NotAssociative   = InfixN
-#else
         moduleEx flags = do
           mbpm <- getParsedModuleWithComments nfp
           -- If ghc was not able to parse the module, we disable hlint diagnostics
@@ -360,11 +321,6 @@ getIdeas recorder nfp = do
 -- and the ModSummary dynflags. However using the parsedFlags extensions
 -- can sometimes interfere with the hlint parsing of the file.
 -- See https://github.com/haskell/haskell-language-server/issues/1279
---
--- Note: this is used when HLINT_ON_GHC_LIB is defined. We seem to need
--- these extensions to construct dynflags to parse the file again. Therefore
--- using hlint default extensions doesn't seem to be a problem when
--- HLINT_ON_GHC_LIB is not defined because we don't parse the file again.
 getExtensions :: NormalizedFilePath -> Action [Extension]
 getExtensions nfp = do
     dflags <- getFlags
@@ -375,7 +331,6 @@ getExtensions nfp = do
         getFlags = do
           modsum <- use_ GetModSummary nfp
           return $ ms_hspp_opts $ msrModSummary modsum
-#endif
 
 -- ---------------------------------------------------------------------
 
@@ -573,7 +528,6 @@ applyHint recorder ide nfp mhint verTxtDocId =
     -- But "Idea"s returned by HLint point to starting position of the expressions
     -- that contain refactorings, so they are often outside the refactorings' boundaries.
     let position = Nothing
-#ifdef HLINT_ON_GHC_LIB
     let writeFileUTF8NoNewLineTranslation file txt =
             withFile file WriteMode $ \h -> do
                 hSetEncoding h utf8
@@ -589,22 +543,6 @@ applyHint recorder ide nfp mhint verTxtDocId =
             let refactExts = map show $ enabled ++ disabled
             (Right <$> applyRefactorings (topDir dflags) position commands temp refactExts)
                 `catches` errorHandlers
-#else
-    mbParsedModule <- liftIO $ runAction' $ getParsedModuleWithComments nfp
-    res <-
-        case mbParsedModule of
-            Nothing -> throwError "Apply hint: error parsing the module"
-            Just pm -> do
-                let anns = pm_annotations pm
-                let modu = pm_parsed_source pm
-                -- apply-refact uses RigidLayout
-                let rigidLayout = deltaOptions RigidLayout
-                (anns', modu') <-
-                    ExceptT $ mapM (uncurry Refact.applyFixities)
-                            $ postParseTransform (Right (anns, [], dflags, modu)) rigidLayout
-                liftIO $ (Right <$> Refact.applyRefactorings' position commands anns' modu')
-                            `catches` errorHandlers
-#endif
     case res of
       Right appliedFile -> do
         let wsEdit = diffText' True (verTxtDocId, oldContent) (T.pack appliedFile) IncludeDeletions