GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

Some printing / verbosity fixes.

Browse Source
This commit is contained in:
bjorn
2008-05-28 15:56:37 +00:00
parent a1944cd308
commit 22a165c266
4 changed files with 55 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
src-3.0/GF/Infra/Option.hs
View File

@@ -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

26
src-3.0/GF/Infra/UseIO.hs
View File

@@ -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)