Remove more CPP pragmas

Author: anka-213

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

@@ -1,6 +1,5 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
-{-# LANGUAGE CPP #-}
 
 module Development.IDE.Core.Preprocessor
   ( preprocessor
@@ -59,7 +58,7 @@ preprocessor env filename mbContents = do
         else do
             cppLogs <- liftIO $ newIORef []
             contents <- ExceptT
-                        $ (Right <$> (runCpp dflags {log_action = logAction cppLogs} filename
+                        $ (Right <$> (runCpp dflags {log_action = logActionCompat $ logAction cppLogs} filename
                                        $ if isOnDisk then Nothing else Just contents))
                             `catch`
                             ( \(e :: GhcException) -> do
@@ -79,12 +78,8 @@ preprocessor env filename mbContents = do
         (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents
         return (contents, opts, dflags)
   where
-    logAction :: IORef [CPPLog] -> LogAction
-#if __GLASGOW_HASKELL__ >= 900
-    logAction cppLogs dflags _reason severity srcSpan msg = do
-#else
+    logAction :: IORef [CPPLog] -> LogActionCompat
     logAction cppLogs dflags _reason severity srcSpan _style msg = do
-#endif
       let log = CPPLog severity srcSpan $ T.pack $ showSDoc dflags msg
       modifyIORef cppLogs (log :)
 

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

@@ -114,6 +114,9 @@ module Development.IDE.GHC.Compat(
     stringToUnit,
     rtsUnit,
 
+    LogActionCompat,
+    logActionCompat,
+
     module GHC,
     module DynFlags,
     initializePlugins,
@@ -404,7 +407,19 @@ oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext
 -- oldFormatErrDoc = Err.formatErrDoc . undefined
 writeIfaceFile = writeIface
 
+type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO ()
+
+-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test.
+logActionCompat :: LogActionCompat -> LogAction
+logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify
+
 #else
+
+type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO ()
+
+logActionCompat :: LogActionCompat -> LogAction
+logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (Out.queryQual style)
+
 type Unit = Module.UnitId
 -- type PackageConfig = Packages.PackageConfig
 definiteUnitId :: Module.DefUnitId -> UnitId

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

@@ -1,6 +1,5 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
-{-# LANGUAGE CPP                #-}
 {-# LANGUAGE ExplicitNamespaces #-}
 
 module Development.IDE.GHC.Warnings(withWarnings) where
@@ -12,6 +11,8 @@ import           GhcPlugins                        as GHC hiding (Var, (<>))
 import           Control.Concurrent.Strict
 import qualified Data.Text                         as T
 
+import           Development.IDE.GHC.Compat        (LogActionCompat,
+                                                    logActionCompat)
 import           Development.IDE.GHC.Error
 import           Development.IDE.Types.Diagnostics
 import           Language.LSP.Types                (type (|?) (..))
@@ -29,18 +30,11 @@ import           Language.LSP.Types                (type (|?) (..))
 withWarnings :: T.Text -> ((ModSummary -> ModSummary) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a)
 withWarnings diagSource action = do
   warnings <- newVar []
-#if __GLASGOW_HASKELL__ >= 900
-  let newAction :: DynFlags -> WarnReason -> Severity -> SrcSpan -> MsgDoc -> IO ()
-      newAction dynFlags wr _ loc msg = do
-        let prUnqual = alwaysQualify :: PrintUnqualified -- TODO: Do something proper here
-#else
-  let newAction :: DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-      newAction dynFlags wr _ loc style msg = do
-        let prUnqual = queryQual style
-#endif
+  let newAction :: LogActionCompat
+      newAction dynFlags wr _ loc prUnqual msg = do
         let wr_d = map ((wr,) . third3 (attachReason wr)) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc prUnqual msg
         modifyVar_ warnings $ return . (wr_d:)
-  res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = newAction}}
+  res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = logActionCompat newAction}}
   warns <- readVar warnings
   return (reverse $ concat warns, res)