Ignore -Werror (#738)

* Ignore -Werror

Fixes #735

* Compat with GHC < 8.8

Author: pepeiborra

session-loader/Development/IDE/Session.hs

@@ -543,6 +543,7 @@ setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target
 setOptions (ComponentOptions theOpts compRoot _) dflags = do
     (dflags', targets) <- addCmdOpts theOpts dflags
     let dflags'' =
+          disableWarningsAsErrors $
           -- disabled, generated directly by ghcide instead
           flip gopt_unset Opt_WriteInterface $
           -- disabled, generated directly by ghcide instead

src/Development/IDE/Core/Preprocessor.hs

@@ -145,7 +145,7 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
     liftIO $ evaluate $ rnf opts
 
     (dflags, _, _) <- parseDynamicFilePragma dflags0 opts
-    return dflags
+    return $ disableWarningsAsErrors dflags
 
 
 -- | Run (unlit) literate haskell preprocessor on a file, or buffer if set

src/Development/IDE/GHC/Compat.hs

@@ -49,11 +49,10 @@ module Development.IDE.GHC.Compat(
     Module.addBootSuffix,
     pattern ModLocation,
     getConArgs,
-
     HasSrcSpan,
     getLoc,
-
     upNameCache,
+    disableWarningsAsErrors,
 
     module GHC,
 #if MIN_GHC_API_VERSION(8,6,0)
@@ -105,6 +104,7 @@ import GHC hiding (
     )
 import qualified HeaderInfo as Hdr
 import Avail
+import Data.List (foldl')
 import ErrUtils (ErrorMessages)
 import FastString (FastString)
 
@@ -124,6 +124,7 @@ import System.FilePath ((-<.>))
 #endif
 
 #if !MIN_GHC_API_VERSION(8,8,0)
+import qualified EnumSet
 
 #if MIN_GHC_API_VERSION(8,6,0)
 import GhcPlugins (srcErrorMessages)
@@ -430,3 +431,13 @@ getConArgs = GHC.getConDetails
 
 getPackageName :: DynFlags -> Module.InstalledUnitId -> Maybe PackageName
 getPackageName dfs i = packageName <$> lookupPackage dfs (Module.DefiniteUnitId (Module.DefUnitId i))
+
+disableWarningsAsErrors :: DynFlags -> DynFlags
+disableWarningsAsErrors df =
+    flip gopt_unset Opt_WarnIsError $ foldl' wopt_unset_fatal df [toEnum 0 ..]
+
+#if !MIN_GHC_API_VERSION(8,8,0)
+wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
+wopt_unset_fatal dfs f
+    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
+#endif

src/Development/IDE/GHC/Util.hs

@@ -29,6 +29,7 @@ module Development.IDE.GHC.Util(
     hDuplicateTo',
     setHieDir,
     dontWriteHieFiles,
+    disableWarningsAsErrors,
     ) where
 
 import Control.Concurrent

test/exe/Main.hs

@@ -469,6 +469,34 @@ diagnosticTests = testGroup "diagnostics"
             Lens.filtered (T.isInfixOf ("/" <> name <> ".hs:"))
           failure msg = liftIO $ assertFailure $ "Expected file path to be stripped but got " <> T.unpack msg
       Lens.mapMOf_ offenders failure notification
+  , testSession' "-Werror in cradle is ignored" $ \sessionDir -> do
+      liftIO $ writeFile (sessionDir </> "hie.yaml")
+        "cradle: {direct: {arguments: [\"-Wall\", \"-Werror\"]}}"
+      let fooContent = T.unlines
+            [ "module Foo where"
+            , "foo = ()"
+            ]
+      _ <- createDoc "Foo.hs" "haskell" fooContent
+      expectDiagnostics
+        [ ( "Foo.hs"
+          , [(DsWarning, (1, 0), "Top-level binding with no type signature:")
+            ]
+          )
+        ]
+  , testSessionWait "-Werror in pragma is ignored" $ do
+      let fooContent = T.unlines
+            [ "{-# OPTIONS_GHC -Wall -Werror #-}"
+            , "module Foo() where"
+            , "foo :: Int"
+            , "foo = 1"
+            ]
+      _ <- createDoc "Foo.hs" "haskell" fooContent
+      expectDiagnostics
+        [ ( "Foo.hs"
+          , [(DsWarning, (3, 0), "Defined but not used:")
+            ]
+          )
+        ]
   ]
 
 codeActionTests :: TestTree
@@ -3122,7 +3150,7 @@ mkRange :: Int -> Int -> Int -> Int -> Range
 mkRange a b c d = Range (Position a b) (Position c d)
 
 run :: Session a -> IO a
-run s = withTempDir $ \dir -> runInDir dir s
+run s = run' (const s)
 
 runWithExtraFiles :: FilePath -> (FilePath -> Session a) -> IO a
 runWithExtraFiles prefix s = withTempDir $ \dir -> do