Remove a bit of CPP by refactoring it into Compat layer

Author: wz1000

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

@@ -821,23 +821,14 @@ parseHeader dflags filename contents = do
    case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of
 #if MIN_VERSION_ghc(8,10,0)
      PFailed pst ->
-        throwE $ diagFromErrMsgs "parser" dflags
-#if MIN_VERSION_ghc(9,2,0)
-               $ fmap pprError
-#endif
-               $ getErrorMessages pst
-#if !MIN_VERSION_ghc(9,2,0)
-                   dflags
-#endif
+        throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages' pst dflags
 #else
      PFailed _ locErr msgErr ->
         throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
 #endif
      POk pst rdr_module -> do
-        let (warns, errs) = getMessages pst
-#if !MIN_VERSION_ghc(9,2,0)
-                              dflags
-#endif
+        let (warns, errs) = getMessages' pst dflags
+
         -- Just because we got a `POk`, it doesn't mean there
         -- weren't errors! To clarify, the GHC parser
         -- distinguishes between fatal and non-fatal
@@ -848,9 +839,9 @@ parseHeader dflags filename contents = do
         -- errors are those from which a parse tree just can't
         -- be produced.
         unless (null errs) $
-            throwE $ diagFromErrMsgs "parser" dflags (fmap pprError errs)
+            throwE $ diagFromErrMsgs "parser" dflags errs
 
-        let warnings = diagFromErrMsgs "parser" dflags (fmap pprWarning warns)
+        let warnings = diagFromErrMsgs "parser" dflags warns
         return (warnings, rdr_module)
 
 -- | Given a buffer, flags, and file path, produce a
@@ -870,28 +861,15 @@ parseFileContents env customPreprocessor filename ms = do
 #if MIN_VERSION_ghc(8,10,0)
      PFailed pst -> throwE
                   $ diagFromErrMsgs "parser" dflags
-#if  MIN_VERSION_ghc(9,2,0)
-                  $ fmap pprError
-#endif
-                  $ getErrorMessages pst
-#if !MIN_VERSION_ghc(9,2,0)
-                  $ dflags
-#endif
+                  $ getErrorMessages' pst dflags
 #else
      PFailed _ locErr msgErr ->
       throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
 #endif
      POk pst rdr_module ->
          let
              hpm_annotations = mkApiAnns pst
-             (warns, errs) = id
-#if MIN_VERSION_ghc(9,2,0)
-                           $ bimap (fmap pprWarning) (fmap pprError)
-#endif
-                           $ getMessages pst
-#if !MIN_VERSION_ghc(9,2,0)
-                           $ dflags
-#endif
+             (warns, errs) = getMessages' pst dflags
          in
            do
                -- Just because we got a `POk`, it doesn't mean there

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

@@ -16,6 +16,8 @@ module Development.IDE.GHC.Compat(
     upNameCache,
     disableWarningsAsErrors,
     reLoc,
+    getErrorMessages',
+    getMessages',
 
 #if !MIN_VERSION_ghc(9,0,1)
     RefMap,
@@ -117,6 +119,7 @@ import           Data.IORef
 
 import qualified Data.Map               as Map
 import           Data.List              (foldl')
+import           Data.Bifunctor
 
 #if MIN_VERSION_ghc(9,0,0)
 import qualified Data.Set               as S
@@ -134,6 +137,31 @@ hPutStringBuffer hdl (StringBuffer buf len cur)
              hPutBuf hdl ptr len
 #endif
 
+#if MIN_VERSION_ghc(9,2,0)
+type ErrMsg  = MsgEnvelope DecoratedSDoc
+type WarnMsg = MsgEnvelope DecoratedSDoc
+#endif
+
+getErrorMessages' :: PState -> DynFlags -> Bag ErrMsg
+getErrorMessages' pst dflags =
+#if MIN_VERSION_ghc(9,2,0)
+                 fmap pprError $
+#endif
+                 getErrorMessages pst
+#if !MIN_VERSION_ghc(9,2,0)
+                   dflags
+#endif
+
+getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg)
+getMessages' pst dflags =
+#if MIN_VERSION_ghc(9,2,0)
+                 bimap (fmap pprWarning) (fmap pprError) $
+#endif
+                 getMessages pst
+#if !MIN_VERSION_ghc(9,2,0)
+                   dflags
+#endif
+
 supportsHieFiles :: Bool
 supportsHieFiles = True