Skip to content

Commit 6b1f66e

Browse files
committed
Fix compatibility with GHC 9.4 and rename function
1 parent af9cd22 commit 6b1f66e

File tree

3 files changed

+12
-9
lines changed

3 files changed

+12
-9
lines changed

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

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE CPP #-}
23
module Development.IDE.GHC.Compat.Error (
34
-- * Top-level error types and lens for easy access
45
MsgEnvelope(..),
@@ -7,7 +8,7 @@ module Development.IDE.GHC.Compat.Error (
78
-- * Error messages for the typechecking and renamer phase
89
TcRnMessage (..),
910
TcRnMessageDetailed (..),
10-
flatTcRnMessage,
11+
stripTcRnMessageContext,
1112
-- * Parsing error message
1213
PsMessage(..),
1314
-- * Desugaring diagnostic
@@ -52,13 +53,15 @@ _GhcDriverMessage = prism' GhcDriverMessage (\case
5253
-- | Some 'TcRnMessage's are nested in other constructors for additional context.
5354
-- For example, 'TcRnWithHsDocContext' and 'TcRnMessageWithInfo'.
5455
-- However, in some occasions you don't need the additional context and you just want
55-
-- the error message. @'flatTcRnMessage'@ recursively unwraps these constructors,
56+
-- the error message. @'stripTcRnMessageContext'@ recursively unwraps these constructors,
5657
-- until there are no more constructors with additional context.
5758
--
58-
flatTcRnMessage :: TcRnMessage -> TcRnMessage
59-
flatTcRnMessage = \case
60-
TcRnWithHsDocContext _ tcMsg -> flatTcRnMessage tcMsg
61-
TcRnMessageWithInfo _ (TcRnMessageDetailed _ tcMsg) -> flatTcRnMessage tcMsg
59+
stripTcRnMessageContext :: TcRnMessage -> TcRnMessage
60+
stripTcRnMessageContext = \case
61+
#if MIN_VERSION_ghc(9, 6, 1)
62+
TcRnWithHsDocContext _ tcMsg -> stripTcRnMessageContext tcMsg
63+
#endif
64+
TcRnMessageWithInfo _ (TcRnMessageDetailed _ tcMsg) -> stripTcRnMessageContext tcMsg
6265
msg -> msg
6366

6467
msgEnvelopeErrorL :: Lens' (MsgEnvelope e) e

ghcide/src/Development/IDE/Types/Diagnostics.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -209,7 +209,7 @@ instance NFData ShowDiagnostic where
209209
--
210210
-- This produces a value of type `Maybe TcRnMessage`.
211211
--
212-
-- Further, consider utility functions such as 'flatTcRnMessage', which strip
212+
-- Further, consider utility functions such as 'stripTcRnMessageContext', which strip
213213
-- context from error messages which may be more convenient in certain situations.
214214
data StructuredMessage
215215
= NoStructuredMessage

plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Development.IDE.Core.PositionMapping (fromCurrentRange)
3232
import Development.IDE.GHC.Compat
3333
import Development.IDE.GHC.Compat.Error (TcRnMessage (..),
3434
_TcRnMessage,
35-
flatTcRnMessage,
35+
stripTcRnMessageContext,
3636
msgEnvelopeErrorL)
3737
import Development.IDE.GHC.Compat.Util
3838
import Development.IDE.Spans.AtPoint (pointCommand)
@@ -196,7 +196,7 @@ isClassMethodWarning message = case message ^? _SomeStructuredMessage . msgEnvel
196196
Just tcRnMessage -> isUnsatisfiedMinimalDefWarning tcRnMessage
197197

198198
isUnsatisfiedMinimalDefWarning :: TcRnMessage -> Maybe ClassMinimalDef
199-
isUnsatisfiedMinimalDefWarning = flatTcRnMessage >>> \case
199+
isUnsatisfiedMinimalDefWarning = stripTcRnMessageContext >>> \case
200200
TcRnUnsatisfiedMinimalDef classMinDef -> Just classMinDef
201201
_ -> Nothing
202202

0 commit comments

Comments
 (0)