Some printing / verbosity fixes.

4 files changed, 55 insertions, 61 deletions

diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs
index 72b13998e..067e8743d 100644
--- a/src-3.0/GF/Compile.hs
+++ b/src-3.0/GF/Compile.hs
@@ -48,7 +48,7 @@ compileToGFCC opts fs =
 
 link :: Options -> String -> SourceGrammar -> IOE GFCC
 link opts cnc gr =
-    do gc1 <- putPointE opts "linking ... " $
+    do gc1 <- putPointE Normal opts "linking ... " $
                 let (abs,gc0) = mkCanon2gfcc opts cnc gr
                 in ioeIO $ checkGFCCio gc0
        return $ buildParser opts $ optimize opts gc1
@@ -103,12 +103,10 @@ compileModule opts1 env file = do
 compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
 compileOne opts env@(_,srcgr,_) file = do
 
-  let putp s = putPointE opts s
-  let putpp = putPointEsil opts
   let putpOpt v m act
-       | beVerbose opts =  putp v act
-       | beSilent opts  =  putpp v act
-       | otherwise = ioeIO (putStrFlush m) >> act
+       | verbAtLeast opts Verbose = putPointE Normal opts v act
+       | verbAtLeast opts Normal  = ioeIO (putStrFlush m) >> act
+       | otherwise                = putPointE Verbose opts v act
 
   let gf   = takeExtensions file
   let path = dropFileName file
@@ -120,9 +118,9 @@ compileOne opts env@(_,srcgr,_) file = do
     -- for compiled gf, read the file and update environment
     -- also undo common subexp optimization, to enable normal computations
     ".gfo" -> do
-       sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
+       sm0 <- putPointE Normal opts ("+ reading" +++ file) $ getSourceModule opts file
        let sm1 = unsubexpModule sm0
-       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
+       sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule mos sm1
        
        extendCompileEnv env file sm
 
@@ -139,7 +137,7 @@ compileOne opts env@(_,srcgr,_) file = do
                                            getSourceModule opts file
        (k',sm)  <- compileSourceModule opts env sm0
        let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
-       cm  <- putpp "  generating code... " $ generateModuleCode opts gfo sm1
+       cm  <- putPointE Verbose opts "  generating code... " $ generateModuleCode opts gfo sm1
           -- sm is optimized before generation, but not in the env
        extendCompileEnvInt env k' gfo sm1
   where
@@ -152,8 +150,8 @@ compileSourceModule :: Options -> CompileEnv ->
                        SourceModule -> IOE (Int,SourceModule)
 compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
 
-  let putp  = putPointE opts
-      putpp = putPointEsil opts
+  let putp  = putPointE Normal opts
+      putpp = putPointE Verbose opts
       mos   = modules gr
 
   mo1   <- ioeErr $ rebuildModule mos mo
@@ -190,12 +188,8 @@ generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
 generateModuleCode opts file minfo = do
   let minfo1 = subexpModule minfo
       out    = prGrammar (MGrammar [minfo1])
-  putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ out
+  putPointE Normal opts ("  wrote file" +++ file) $ ioeIO $ writeFile file $ out
   return minfo1
- where
-   putp  = putPointE opts
-   putpp = putPointEsil opts
-
 
 -- auxiliaries
 
diff --git a/src-3.0/GF/Compile/Optimize.hs b/src-3.0/GF/Compile/Optimize.hs
index 6dd4c9af6..9263dcdd9 100644
--- a/src-3.0/GF/Compile/Optimize.hs
+++ b/src-3.0/GF/Compile/Optimize.hs
@@ -110,7 +110,7 @@ evalCncInfo ::
   Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
 evalCncInfo opts gr cnc abs (c,info) = do
 
- seq (prtIf (beVerbose opts) c) $ return ()
+ seq (prtIf (verbAtLeast opts Verbose) c) $ return ()
 
  errIn ("optimizing" +++ prt c) $ case info of
 
diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs
index dc795e597..a17613f7f 100644
--- a/src-3.0/GF/Infra/Option.hs
+++ b/src-3.0/GF/Infra/Option.hs
@@ -3,7 +3,7 @@ module GF.Infra.Option
      -- * Option types
      Options, ModuleOptions,
      Flags(..), ModuleFlags(..),
-     Mode(..), Phase(..), Encoding(..), OutputFormat(..), Optimization(..),
+     Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), Optimization(..),
      Dump(..), Printer(..), Recomp(..),
      -- * Option parsing 
      parseOptions, parseModuleOptions,
@@ -17,8 +17,7 @@ module GF.Infra.Option
      -- * Checking options
      flag, moduleFlag,
      -- * Convenience methods for checking options    
-     beVerbose, beSilent,
-     dump
+     verbAtLeast, dump
     ) where
 
 import Control.Monad
@@ -65,6 +64,9 @@ errors = fail . unlines
 data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeCompiler
   deriving (Show,Eq,Ord)
 
+data Verbosity = Quiet | Normal | Verbose | Debug
+  deriving (Show,Eq,Ord,Enum,Bounded)
+
 data Phase = Preproc | Convert | Compile | Link
   deriving (Show,Eq,Ord)
 
@@ -112,7 +114,7 @@ data ModuleFlags = ModuleFlags {
 data Flags = Flags {
       optMode            :: Mode,
       optStopAfterPhase  :: Phase,
-      optVerbosity       :: Int,
+      optVerbosity       :: Verbosity,
       optShowCPUTime     :: Bool,
       optEmitGFO         :: Bool,
       optGFODir          :: FilePath,
@@ -245,7 +247,7 @@ defaultFlags :: Flags
 defaultFlags = Flags {
       optMode            = ModeInteractive,
       optStopAfterPhase  = Compile,
-      optVerbosity       = 1,
+      optVerbosity       = Normal,
       optShowCPUTime     = False,
       optEmitGFO         = True,
       optGFODir          = ".",
@@ -334,7 +336,7 @@ optDescr =
     [
      Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.",
      Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.",
-     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
+     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.",
      Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
      Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.",
      Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
@@ -370,10 +372,10 @@ optDescr =
  where phase       x = set $ \o -> o { optStopAfterPhase = x }
        mode        x = set $ \o -> o { optMode = x }
        verbosity mv  = case mv of
-                           Nothing -> set $ \o -> o { optVerbosity = 3 }
-                           Just v  -> case reads v of
-                                        [(i,"")] | i >= 0 -> set $ \o -> o { optVerbosity = i }
-                                        _        -> fail $ "Bad verbosity: " ++ show v
+                           Nothing -> set $ \o -> o { optVerbosity = Verbose }
+                           Just v  -> case readMaybe v >>= toEnumBounded of
+                                        Just i  -> set $ \o -> o { optVerbosity = i }
+                                        Nothing -> fail $ "Bad verbosity: " ++ show v
        cpu         x = set $ \o -> o { optShowCPUTime = x }
        emitGFO     x = set $ \o -> o { optEmitGFO = x }
        gfoDir      x = set $ \o -> o { optGFODir = x }
@@ -387,14 +389,6 @@ optDescr =
 
        set = return . Options
 
-instance Functor OptDescr where
-    fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
-
-instance Functor ArgDescr where
-    fmap f (NoArg x)    = NoArg (f x)
-    fmap f (ReqArg g s) = ReqArg (f . g) s
-    fmap f (OptArg g s) = OptArg (f . g) s
-
 outputFormats :: [(String,OutputFormat)]
 outputFormats = 
     [("gfcc",         FmtGFCC),
@@ -453,12 +447,34 @@ splitInModuleSearchPath s = case break isPathSep s of
 -- * Convenience functions for checking options
 --
 
-beVerbose :: Options -> Bool
-beVerbose = flag ((>= 3) . optVerbosity)
-
-beSilent :: Options -> Bool
-beSilent = flag ((<= 0) . optVerbosity)
+verbAtLeast :: Options -> Verbosity -> Bool
+verbAtLeast opts v = flag optVerbosity opts >= v
 
 dump :: Options -> Dump -> Bool
 dump opts d = moduleFlag ((d `elem`) . optDump) opts
 
+
+--
+-- * General utilities
+--
+
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case reads s of
+                [(x,"")] -> Just x
+                _        -> Nothing
+
+toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a
+toEnumBounded i = let mi = minBound
+                      ma = maxBound `asTypeOf` mi                      
+                   in if i >= fromEnum mi && i <= fromEnum ma 
+                        then Just (toEnum i `asTypeOf` mi)
+                        else Nothing
+
+
+instance Functor OptDescr where
+    fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
+
+instance Functor ArgDescr where
+    fmap f (NoArg x)    = NoArg (f x)
+    fmap f (ReqArg g s) = ReqArg (f . g) s
+    fmap f (OptArg g s) = OptArg (f . g) s
\ No newline at end of file
diff --git a/src-3.0/GF/Infra/UseIO.hs b/src-3.0/GF/Infra/UseIO.hs
index dcc0c62ca..f7563ed2c 100644
--- a/src-3.0/GF/Infra/UseIO.hs
+++ b/src-3.0/GF/Infra/UseIO.hs
@@ -40,15 +40,11 @@ putShow' f = putStrLn . show . length . show . f
 
 putIfVerb :: Options -> String -> IO ()
 putIfVerb opts msg =
-      if beVerbose opts
-         then putStrLn msg
-         else return ()
+      when (verbAtLeast opts Verbose) $ putStrLn msg
 
 putIfVerbW :: Options -> String -> IO ()
 putIfVerbW opts msg =
-      if beVerbose opts
-         then putStr (' ' : msg)
-         else return ()
+      when (verbAtLeast opts Verbose) $ putStr (' ' : msg)
 
 errOptIO :: Options -> a -> Err a -> IO a
 errOptIO os e m = case m of
@@ -245,17 +241,9 @@ putStrLnE = ioeIO . putStrLnFlush
 putStrE :: String -> IOE ()
 putStrE = ioeIO . putStrFlush 
 
--- this is more verbose
-putPointE :: Options -> String -> IOE a -> IOE a
-putPointE = putPointEgen beSilent
-
--- this is less verbose
-putPointEsil :: Options -> String -> IOE a -> IOE a
-putPointEsil = putPointEgen (not . beVerbose)
-
-putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
-putPointEgen cond opts msg act = do
-  when (cond opts) $ ioeIO $ putStrFlush msg
+putPointE :: Verbosity -> Options -> String -> IOE a -> IOE a
+putPointE v opts msg act = do
+  when (verbAtLeast opts v) $ ioeIO $ putStrFlush msg
 
   t1 <- ioeIO $ getCPUTime
   a <- act >>= ioeIO . evaluate
@@ -265,10 +253,6 @@ putPointEgen cond opts msg act = do
   return a
 
 
--- | forces verbosity
-putPointEVerb :: Options -> String -> IOE a -> IOE a
-putPointEVerb = putPointEgen (const False)
-
 -- ((do {s <- readFile f; return (return s)}) ) 
 readFileIOE :: FilePath -> IOE BS.ByteString
 readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)