From a75db99a9c2fb5b22a65c0a5b030c855dd1d8cba Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Fri, 11 Apr 2008 17:24:00 +0000
Subject: Add a flag for turning off all warnings

---
 src/Haddock/Interface.hs        |  3 ++-
 src/Haddock/Interface/Rename.hs | 12 ++++++------
 src/Haddock/Options.hs          |  4 +++-
 tests/runtests.hs               |  2 +-
 4 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index 51d8de2c..8b8d703d 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -50,7 +50,8 @@ createInterfaces modules externalLinks flags = (interfaces, homeLinks, messages)
       let interfaces' = attachInstances interfaces allNames
  
       -- part 3, rename the interfaces
-      interfaces'' <- mapM (renameInterface links) interfaces'
+      let warnings = Flag_NoWarnings `notElem` flags
+      interfaces'' <- mapM (renameInterface links warnings) interfaces'
 
       return (interfaces'', homeLinks)
   
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 11a0a14c..5ce6aa24 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -29,8 +29,8 @@ import Control.Arrow
 import Control.Monad hiding (mapM)
 
 
-renameInterface :: LinkEnv -> Interface -> ErrMsgM Interface
-renameInterface renamingEnv mod =
+renameInterface :: LinkEnv -> Bool -> Interface -> ErrMsgM Interface
+renameInterface renamingEnv warnings mod =
 
   -- first create the local env, where every name exported by this module
   -- is mapped to itself, and everything else comes from the global renaming
@@ -66,10 +66,10 @@ renameInterface renamingEnv mod =
   in do
     -- report things that we couldn't link to. Only do this for non-hidden
     -- modules.
-    when (OptHide `notElem` ifaceOptions mod && not (null strings)) $
-	  tell ["Warning: " ++ show (ppr (ifaceMod mod) defaultUserStyle) ++ 
-		": could not find link destinations for:\n"++
-		"   " ++ concat (map (' ':) strings) ]
+    unless (OptHide `elem` ifaceOptions mod || null strings || not warnings) $
+      tell ["Warning: " ++ show (ppr (ifaceMod mod) defaultUserStyle) ++
+            ": could not find link destinations for:\n"++
+            "   " ++ concat (map (' ':) strings) ]
 
     return $ mod { ifaceRnDoc = finalModuleDoc,
                    ifaceRnDocMap = rnDocMap,
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 31976ae0..6e5514cf 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -83,6 +83,7 @@ data Flag
   | Flag_OptGhc String
   | Flag_GhcLibDir String
   | Flag_GhcVersion
+  | Flag_NoWarnings
   deriving (Eq)
 
 
@@ -149,5 +150,6 @@ options backwardsCompat =
     Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION")
  	"Forward option to GHC",
     Option []  ["ghc-version"]  (NoArg Flag_GhcVersion)
-	"output GHC version in numeric format"
+	"output GHC version in numeric format",
+    Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings"
    ]
diff --git a/tests/runtests.hs b/tests/runtests.hs
index 480a0961..0f815294 100644
--- a/tests/runtests.hs
+++ b/tests/runtests.hs
@@ -61,7 +61,7 @@ testDir libdir dir = do
   let mods' = map (dir </>) mods
   let outdir = "output" </> dir
   createDirectoryIfMissing True outdir
-  code <- system $ printf "../dist/build/haddock/haddock -B %s -o %s -h --optghc=-fglasgow-exts --optghc=-w %s" libdir outdir (unwords mods')
+  code <- system $ printf "../dist/build/haddock/haddock -B %s -w -o %s -h --optghc=-fglasgow-exts --optghc=-w %s" libdir outdir (unwords mods')
   unless (code == ExitSuccess) $ error "Haddock run failed! Exiting."
   check mods'
   walkDirs libdir dir
-- 
cgit v1.2.3