Skip to content

Commit bf6d188

Browse files
fendorfendor
committed
Move backwards compatibility code
1 parent b3cab6b commit bf6d188

File tree

5 files changed

+57
-49
lines changed

5 files changed

+57
-49
lines changed

‎ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -132,9 +132,6 @@ import qualified GHC as G
132132
import GHC.Hs (LEpaComment)
133133
import qualified GHC.Types.Error as Error
134134
#endif
135-
#if MIN_VERSION_ghc(9,3,0)
136-
import GHC.Driver.Plugins (PsMessages (..))
137-
#endif
138135

139136
-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
140137
parseModule
@@ -475,7 +472,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
475472
Nothing
476473
#endif
477474

478-
#else
475+
#else
479476
let !partial_iface = force (mkPartialIface session details simplified_guts)
480477
final_iface <- mkFullIface session partial_iface
481478
#endif
@@ -1222,7 +1219,7 @@ parseHeader dflags filename contents = do
12221219
PFailedWithErrorMessages msgs ->
12231220
throwE $ diagFromErrMsgs "parser" dflags $ msgs dflags
12241221
POk pst rdr_module -> do
1225-
let (warns, errs) = renderMessages $ getMessages' pst dflags
1222+
let (warns, errs) = renderMessages $ getPsMessages pst dflags
12261223

12271224
-- Just because we got a `POk`, it doesn't mean there
12281225
-- weren't errors! To clarify, the GHC parser
@@ -1257,7 +1254,7 @@ parseFileContents env customPreprocessor filename ms = do
12571254
POk pst rdr_module ->
12581255
let
12591256
hpm_annotations = mkApiAnns pst
1260-
psMessages = getMessages' pst dflags
1257+
psMessages = getPsMessages pst dflags
12611258
in
12621259
do
12631260
let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module

‎ghcide/src/Development/IDE/GHC/Compat.hs

Lines changed: 1 addition & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ module Development.IDE.GHC.Compat(
2525
disableWarningsAsErrors,
2626
reLoc,
2727
reLocA,
28-
getMessages',
28+
getPsMessages,
2929
renderMessages,
3030
pattern PFailedWithErrorMessages,
3131
isObjectLinkable,
@@ -373,31 +373,6 @@ corePrepExpr _ = GHC.corePrepExpr
373373
simplifyExpr df _ = GHC.simplifyExpr df
374374
#endif
375375

376-
#if MIN_VERSION_ghc(9,2,0)
377-
type ErrMsg = MsgEnvelope DecoratedSDoc
378-
#endif
379-
#if MIN_VERSION_ghc(9,3,0)
380-
type WarnMsg = MsgEnvelope DecoratedSDoc
381-
#endif
382-
383-
#if !MIN_VERSION_ghc(9,3,0)
384-
type PsMessages = (Bag WarnMsg, Bag ErrMsg)
385-
#endif
386-
387-
getMessages' :: PState -> DynFlags -> PsMessages
388-
getMessages' pst dflags =
389-
#if MIN_VERSION_ghc(9,3,0)
390-
uncurry PsMessages $ getPsMessages pst
391-
#else
392-
#if MIN_VERSION_ghc(9,2,0)
393-
bimap (fmap pprWarning) (fmap pprError) $
394-
#endif
395-
getMessages pst
396-
#if !MIN_VERSION_ghc(9,2,0)
397-
dflags
398-
#endif
399-
#endif
400-
401376
renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
402377
renderMessages msgs =
403378
#if MIN_VERSION_ghc(9,3,0)

‎ghcide/src/Development/IDE/GHC/Compat/Core.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -579,7 +579,7 @@ import GHC.Parser.Header hiding (getImports)
579579
#if MIN_VERSION_ghc(9,2,0)
580580
import qualified GHC.Linker.Loader as Linker
581581
import GHC.Linker.Types
582-
import GHC.Parser.Lexer hiding (initParserState)
582+
import GHC.Parser.Lexer hiding (initParserState, getPsMessages)
583583
import GHC.Parser.Annotation (EpAnn (..))
584584
import GHC.Platform.Ways
585585
import GHC.Runtime.Context (InteractiveImport (..))

‎ghcide/src/Development/IDE/GHC/Compat/Outputable.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ module Development.IDE.GHC.Compat.Outputable (
2727
-- * Error infrastructure
2828
DecoratedSDoc,
2929
MsgEnvelope,
30+
ErrMsg,
31+
WarnMsg,
3032
errMsgSpan,
3133
errMsgSeverity,
3234
formatErrorWithQual,
@@ -192,6 +194,13 @@ type PsWarning = ErrMsg
192194
type PsError = ErrMsg
193195
#endif
194196

197+
#if MIN_VERSION_ghc(9,2,0)
198+
type ErrMsg = MsgEnvelope DecoratedSDoc
199+
#endif
200+
#if MIN_VERSION_ghc(9,3,0)
201+
type WarnMsg = MsgEnvelope DecoratedSDoc
202+
#endif
203+
195204
mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
196205
mkPrintUnqualifiedDefault env =
197206
#if MIN_VERSION_ghc(9,2,0)

‎ghcide/src/Development/IDE/GHC/Compat/Plugins.hs

Lines changed: 43 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
-- | Plugin Compat utils.
44
module Development.IDE.GHC.Compat.Plugins (
5+
-- * Plugin Compat Types, and initialisation
56
Plugin(..),
67
defaultPlugin,
78
PluginWithArgs(..),
@@ -12,32 +13,58 @@ module Development.IDE.GHC.Compat.Plugins (
1213
-- * Static plugins
1314
StaticPlugin(..),
1415
hsc_static_plugins,
16+
17+
-- * Plugin messages
18+
PsMessages(..),
19+
getPsMessages
1520
) where
1621

1722
#if MIN_VERSION_ghc(9,0,0)
1823
#if MIN_VERSION_ghc(9,2,0)
19-
import qualified GHC.Driver.Env as Env
24+
import qualified GHC.Driver.Env as Env
2025
#endif
21-
import GHC.Driver.Plugins (Plugin (..),
22-
PluginWithArgs (..),
23-
StaticPlugin (..),
24-
defaultPlugin, withPlugins)
26+
import GHC.Driver.Plugins (Plugin (..),
27+
PluginWithArgs (..),
28+
StaticPlugin (..),
29+
defaultPlugin,
30+
withPlugins)
2531
#if MIN_VERSION_ghc(9,3,0)
26-
import GHC.Driver.Plugins (ParsedResult (..),
27-
PsMessages (..),
28-
staticPlugins)
32+
import GHC.Driver.Plugins (ParsedResult (..),
33+
PsMessages (..),
34+
staticPlugins)
35+
import qualified GHC.Parser.Lexer as Lexer
36+
#else
37+
import Data.Bifunctor (bimap)
2938
#endif
30-
import qualified GHC.Runtime.Loader as Loader
39+
import qualified GHC.Runtime.Loader as Loader
3140
#else
32-
import qualified DynamicLoading as Loader
41+
import qualified DynamicLoading as Loader
3342
import Plugins
3443
#endif
3544
import Development.IDE.GHC.Compat.Core
36-
import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags)
37-
import Development.IDE.GHC.Compat.Parser as Parser
38-
import Debug.Trace
39-
import GHC.Driver.Env (hsc_plugins)
40-
import GHC.Driver.Plugins
45+
import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags)
46+
import Development.IDE.GHC.Compat.Outputable as Out
47+
import Development.IDE.GHC.Compat.Parser as Parser
48+
import Development.IDE.GHC.Compat.Util (Bag)
49+
50+
51+
#if !MIN_VERSION_ghc(9,3,0)
52+
type PsMessages = (Bag WarnMsg, Bag ErrMsg)
53+
#endif
54+
55+
getPsMessages :: PState -> DynFlags -> PsMessages
56+
getPsMessages pst dflags =
57+
#if MIN_VERSION_ghc(9,3,0)
58+
uncurry PsMessages $ Lexer.getPsMessages pst
59+
#else
60+
#if MIN_VERSION_ghc(9,2,0)
61+
bimap (fmap pprWarning) (fmap pprError) $
62+
#endif
63+
getMessages pst
64+
#if !MIN_VERSION_ghc(9,2,0)
65+
dflags
66+
#endif
67+
#endif
4168

4269
applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages)
4370
applyPluginsParsedResultAction env dflags ms hpm_annotations parsed msgs = do
@@ -46,7 +73,7 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed msgs = do
4673
#if MIN_VERSION_ghc(9,3,0)
4774
fmap (\result -> (hpm_module (parsedResultModule result), (parsedResultMessages result))) $ runHsc env $ withPlugins
4875
#else
49-
fmap ((, msgs), hpm_module) $ runHsc env $ withPlugins
76+
fmap (\parsed_module -> (hpm_module parsed_module, msgs)) $ runHsc env $ withPlugins
5077
#endif
5178
#if MIN_VERSION_ghc(9,3,0)
5279
(Env.hsc_plugins env)

0 commit comments

Comments
 (0)