From a1b57146c5678b32eb5ac37021e93a81a4b73007 Mon Sep 17 00:00:00 2001
From: Doug Wilson <dwilson@ricoh.co.nz>
Date: Sat, 3 Jun 2017 22:02:08 +1200
Subject: Disable pattern match warnings (#628)

This disables the pattern match checker which can be very expensive in some
cases.

The disabled warnings include:
* Opt_WarnIncompletePatterns
* Opt_WarnIncompleteUniPatterns
* Opt_WarnIncompletePatternsRecUpd
* Opt_WarnOverlappingPatterns
---
 haddock-api/src/Haddock.hs | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

(limited to 'haddock-api/src')

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 637ccf2b..080ff926 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -41,7 +41,7 @@ import Haddock.Utils
 
 import Control.Monad hiding (forM_)
 import Control.Applicative
-import Data.Foldable (forM_)
+import Data.Foldable (forM_, foldl')
 import Data.List (isPrefixOf)
 import Control.Exception
 import Data.Maybe
@@ -72,6 +72,8 @@ import Packages
 import Panic (handleGhcException)
 import Module
 import FastString
+import HscTypes
+import GhcMonad
 
 --------------------------------------------------------------------------------
 -- * Exception handling
@@ -161,7 +163,6 @@ haddockWithGhc ghc args = handleTopExceptions $ do
       hPutStrLn stderr warning
 
   ghc flags' $ do
-
     dflags <- getDynFlags
 
     if not (null files) then do
@@ -397,7 +398,11 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do
     ghcMode   = CompManager,
     ghcLink   = NoLink
     }
-  let dynflags'' = updOptLevel 0 $ gopt_unset dynflags' Opt_SplitObjs
+  -- We disable pattern match warnings because than can be very
+  -- expensive to check
+  let dynflags'' = unsetPatternMatchWarnings $
+        updOptLevel 0 $
+        gopt_unset dynflags' Opt_SplitObjs
   defaultCleanupHandler dynflags'' $ do
       -- ignore the following return-value, which is a list of packages
       -- that may need to be re-linked: Haddock doesn't do any
@@ -414,6 +419,17 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do
         then throwE ("Couldn't parse GHC options: " ++ unwords flags)
         else return dynflags'
 
+unsetPatternMatchWarnings :: DynFlags -> DynFlags
+unsetPatternMatchWarnings dflags =
+  foldl' wopt_unset dflags pattern_match_warnings
+  where
+    pattern_match_warnings =
+      [ Opt_WarnIncompletePatterns
+      , Opt_WarnIncompleteUniPatterns
+      , Opt_WarnIncompletePatternsRecUpd
+      , Opt_WarnOverlappingPatterns
+      ]
+
 -------------------------------------------------------------------------------
 -- * Misc
 -------------------------------------------------------------------------------
-- 
cgit v1.2.3