Skip to content

Commit 4ce409e

Browse files
RaoulHCRaoulHC
committed
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
1 parent 79e36f5 commit 4ce409e

File tree

2 files changed

+7
-75
lines changed

2 files changed

+7
-75
lines changed

‎haskell-language-server.cabal

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -632,8 +632,6 @@ library hls-hlint-plugin
632632
, ghc-lib-parser-ex
633633
, apply-refact
634634

635-
cpp-options: -DHLINT_ON_GHC_LIB
636-
637635
default-extensions:
638636
DataKinds
639637

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

Lines changed: 7 additions & 73 deletions
Original file line numberDiff line numberDiff line change
@@ -18,11 +18,7 @@
1818
-- lots of CPP, we just disable the warning until later.
1919
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
2020

21-
#ifdef HLINT_ON_GHC_LIB
2221
#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib_parser(x,y,z)
23-
#else
24-
#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z)
25-
#endif
2622

2723
module Ide.Plugin.Hlint
2824
(
@@ -61,7 +57,6 @@ import Development.IDE.Core.Shake (getDiagnost
6157
import qualified Refact.Apply as Refact
6258
import qualified Refact.Types as Refact
6359

64-
#ifdef HLINT_ON_GHC_LIB
6560
import Development.IDE.GHC.Compat (DynFlags,
6661
WarningFlag (Opt_WarnUnrecognisedPragmas),
6762
extensionFlags,
@@ -71,18 +66,18 @@ import Development.IDE.GHC.Compat (DynFlags,
7166
import qualified Development.IDE.GHC.Compat.Util as EnumSet
7267

7368
#if MIN_GHC_API_VERSION(9,4,0)
74-
import qualified "ghc-lib-parser" GHC.Data.Strict as Strict
69+
import qualified GHC.Data.Strict as Strict
7570
#endif
7671
#if MIN_GHC_API_VERSION(9,0,0)
77-
import "ghc-lib-parser" GHC.Types.SrcLoc hiding
72+
import GHC.Types.SrcLoc hiding
7873
(RealSrcSpan)
79-
import qualified "ghc-lib-parser" GHC.Types.SrcLoc as GHC
74+
import qualified GHC.Types.SrcLoc as GHC
8075
#else
81-
import "ghc-lib-parser" SrcLoc hiding
76+
import qualified SrcLoc as GHC
77+
import SrcLoc hiding
8278
(RealSrcSpan)
83-
import qualified "ghc-lib-parser" SrcLoc as GHC
8479
#endif
85-
import "ghc-lib-parser" GHC.LanguageExtensions (Extension)
80+
import GHC.LanguageExtensions (Extension)
8681
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension)
8782
import System.FilePath (takeFileName)
8883
import System.IO (IOMode (WriteMode),
@@ -94,21 +89,7 @@ import System.IO (IOMode (Wri
9489
utf8,
9590
withFile)
9691
import System.IO.Temp
97-
#else
98-
import Development.IDE.GHC.Compat hiding
99-
(setEnv,
100-
(<+>))
101-
import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative))
102-
#if MIN_GHC_API_VERSION(9,2,0)
103-
import Language.Haskell.GHC.ExactPrint.ExactPrint (deltaOptions)
104-
#else
105-
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
106-
#endif
107-
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
108-
import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..))
109-
import Language.Haskell.GhclibParserEx.Fixity as GhclibParserEx (applyFixities)
110-
import qualified Refact.Fixity as Refact
111-
#endif
92+
11293
import Ide.Plugin.Config hiding
11394
(Config)
11495
import Ide.Plugin.Error
@@ -159,7 +140,6 @@ instance Pretty Log where
159140
LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
160141
LogResolve msg -> pretty msg
161142

162-
#ifdef HLINT_ON_GHC_LIB
163143
-- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib
164144
#if !MIN_GHC_API_VERSION(9,0,0)
165145
type BufSpan = ()
@@ -173,7 +153,6 @@ pattern RealSrcSpan x y = GHC.RealSrcSpan x y
173153
pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y))
174154
#endif
175155
{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
176-
#endif
177156

178157
#if MIN_GHC_API_VERSION(9,4,0)
179158
fromStrictMaybe :: Strict.Maybe a -> Maybe a
@@ -316,28 +295,6 @@ getIdeas recorder nfp = do
316295
fmap applyHints' (moduleEx flags)
317296

318297
where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx))
319-
#ifndef HLINT_ON_GHC_LIB
320-
moduleEx _flags = do
321-
mbpm <- getParsedModuleWithComments nfp
322-
return $ createModule <$> mbpm
323-
where
324-
createModule pm = Right (createModuleEx anns (applyParseFlagsFixities modu))
325-
where anns = pm_annotations pm
326-
modu = pm_parsed_source pm
327-
328-
applyParseFlagsFixities :: ParsedSource -> ParsedSource
329-
applyParseFlagsFixities modul = GhclibParserEx.applyFixities (parseFlagsToFixities _flags) modul
330-
331-
parseFlagsToFixities :: ParseFlags -> [(String, Fixity)]
332-
parseFlagsToFixities = map toFixity . Hlint.fixities
333-
334-
toFixity :: FixityInfo -> (String, Fixity)
335-
toFixity (name, dir, i) = (name, Fixity NoSourceText i $ f dir)
336-
where
337-
f LeftAssociative = InfixL
338-
f RightAssociative = InfixR
339-
f NotAssociative = InfixN
340-
#else
341298
moduleEx flags = do
342299
mbpm <- getParsedModuleWithComments nfp
343300
-- If ghc was not able to parse the module, we disable hlint diagnostics
@@ -360,11 +317,6 @@ getIdeas recorder nfp = do
360317
-- and the ModSummary dynflags. However using the parsedFlags extensions
361318
-- can sometimes interfere with the hlint parsing of the file.
362319
-- See https://github.com/haskell/haskell-language-server/issues/1279
363-
--
364-
-- Note: this is used when HLINT_ON_GHC_LIB is defined. We seem to need
365-
-- these extensions to construct dynflags to parse the file again. Therefore
366-
-- using hlint default extensions doesn't seem to be a problem when
367-
-- HLINT_ON_GHC_LIB is not defined because we don't parse the file again.
368320
getExtensions :: NormalizedFilePath -> Action [Extension]
369321
getExtensions nfp = do
370322
dflags <- getFlags
@@ -375,7 +327,6 @@ getExtensions nfp = do
375327
getFlags = do
376328
modsum <- use_ GetModSummary nfp
377329
return $ ms_hspp_opts $ msrModSummary modsum
378-
#endif
379330

380331
-- ---------------------------------------------------------------------
381332

@@ -573,7 +524,6 @@ applyHint recorder ide nfp mhint verTxtDocId =
573524
-- But "Idea"s returned by HLint point to starting position of the expressions
574525
-- that contain refactorings, so they are often outside the refactorings' boundaries.
575526
let position = Nothing
576-
#ifdef HLINT_ON_GHC_LIB
577527
let writeFileUTF8NoNewLineTranslation file txt =
578528
withFile file WriteMode $ \h -> do
579529
hSetEncoding h utf8
@@ -589,22 +539,6 @@ applyHint recorder ide nfp mhint verTxtDocId =
589539
let refactExts = map show $ enabled ++ disabled
590540
(Right <$> applyRefactorings (topDir dflags) position commands temp refactExts)
591541
`catches` errorHandlers
592-
#else
593-
mbParsedModule <- liftIO $ runAction' $ getParsedModuleWithComments nfp
594-
res <-
595-
case mbParsedModule of
596-
Nothing -> throwError "Apply hint: error parsing the module"
597-
Just pm -> do
598-
let anns = pm_annotations pm
599-
let modu = pm_parsed_source pm
600-
-- apply-refact uses RigidLayout
601-
let rigidLayout = deltaOptions RigidLayout
602-
(anns', modu') <-
603-
ExceptT $ mapM (uncurry Refact.applyFixities)
604-
$ postParseTransform (Right (anns, [], dflags, modu)) rigidLayout
605-
liftIO $ (Right <$> Refact.applyRefactorings' position commands anns' modu')
606-
`catches` errorHandlers
607-
#endif
608542
case res of
609543
Right appliedFile -> do
610544
let wsEdit = diffText' True (verTxtDocId, oldContent) (T.pack appliedFile) IncludeDeletions

0 commit comments

Comments
 (0)