From 8dfaf2ef65915e7ac91139155d60df85ed66adbb Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Fri, 22 Aug 2014 00:30:33 +0000
Subject: [PATCH] Command line flag -s/-q now silences all warnings

These flags now do what the say.
---
 src/compiler/GF/Compile/CheckGrammar.hs |  8 +++-----
 src/compiler/GF/CompileOne.hs           |  6 +++---
 src/compiler/GF/Infra/CheckM.hs         | 15 ++++++++++-----
 3 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 10cbd4bb9..be6f625a5 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -125,8 +125,7 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
                                     return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
                        Bad _  -> do noLinOf c
                                     return js
-         where noLinOf c = when (verbAtLeast opts Normal) $
-                           checkWarn ("no linearization of" <+> c)
+         where noLinOf c = checkWarn ("no linearization of" <+> c)
        AbsCat (Just _) -> case lookupIdent c js of
          Ok (AnyInd _ _) -> return js
          Ok (CncCat (Just _) _ _ _ _) -> return js
@@ -157,9 +156,8 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
 -- | General Principle: only Just-values are checked. 
 -- A May-value has always been checked in its origin module.
 checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
-checkInfo opts cwd sgr (m,mo) c info = do
-  checkInModule cwd mo NoLoc empty $
-    checkReservedId c
+checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
+  checkReservedId c
   case info of
     AbsCat (Just (L loc cont)) -> 
       mkCheck loc "the category" $ 
diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index c99430079..5310a7ebb 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -20,7 +20,7 @@ import GF.Grammar.Binary(decodeModule,encodeModule)
 
 import GF.Infra.Option
 import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,liftIO,ePutStrLn,putPointE,putStrE)
-import GF.Infra.CheckM(runCheck)
+import GF.Infra.CheckM(runCheck')
 import GF.Data.Operations(liftErr,(+++))
 
 import GF.System.Directory(doesFileExist,getCurrentDirectory)
@@ -67,7 +67,7 @@ reuseGFO opts srcgr file =
      let sm1 = unsubexpModule sm0
      cwd <- getCurrentDirectory
      (sm,warnings) <- -- putPointE Normal opts "creating indirections" $ 
-                      runCheck $ extendModule cwd srcgr sm1
+                      runCheck' opts $ extendModule cwd srcgr sm1
      warnOut opts warnings
 
      if flag optTagsOnly opts
@@ -114,7 +114,7 @@ compileSourceModule opts cwd mb_gfFile gr =
     putpp s = if null s then id else putPointE Verbose opts ("  "++s++" ")
 
     -- * Running a compiler pass, with impedance matching
-    runPass = runPass' fst fst snd (liftErr . runCheck)
+    runPass = runPass' fst fst snd (liftErr . runCheck' opts)
     runPassE = runPass2e liftErr
     runPassI = runPass2e id id Canon
     runPass2e lift f = runPass' id f (const "") lift
diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs
index 80f2409fa..43c43ba27 100644
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -13,7 +13,7 @@
 -----------------------------------------------------------------------------
 
 module GF.Infra.CheckM
-          (Check, CheckResult, Message, runCheck,
+          (Check, CheckResult, Message, runCheck, runCheck',
 	   checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
 	   checkIn, checkInModule, checkMap, checkMapRecover,
            parallelCheck, accumulateError, commitCheck,
@@ -23,6 +23,7 @@ import GF.Data.Operations
 --import GF.Infra.Ident
 --import GF.Grammar.Grammar(msrc) -- ,Context
 import GF.Infra.Location(ppLocation,sourcePath)
+import GF.Infra.Option(Options,noOptions,verbAtLeast,Verbosity(..))
 
 import qualified Data.Map as Map
 import GF.Text.Pretty
@@ -98,15 +99,19 @@ commitCheck c =
     list = vcat . reverse
 
 -- | Run an error check, report errors and warnings
-runCheck :: ErrorMonad m => Check a -> m (a,String)
-runCheck c =
+runCheck c = runCheck' noOptions c
+
+-- | Run an error check, report errors and (optionally) warnings
+runCheck' :: ErrorMonad m => Options -> Check a -> m (a,String)
+runCheck' opts c =
     case unCheck c {-[]-} ([],[]) of
-      (([],ws),Success v) -> return (v,render (list ws))
+      (([],ws),Success v) -> return (v,render (wlist ws))
       (msgs   ,Success v) -> bad msgs
       ((es,ws),Fail    e) -> bad ((e:es),ws)
   where
-    bad (es,ws) = raise (render $ list ws $$ list es)
+    bad (es,ws) = raise (render $ wlist ws $$ list es)
     list = vcat . reverse
+    wlist ws = if verbAtLeast opts Normal then list ws else empty
 
 parallelCheck :: [Check a] -> Check [a]
 parallelCheck cs =