diff options
| author | bjorn <bjorn@bringert.net> | 2008-05-28 15:10:36 +0000 |
|---|---|---|
| committer | bjorn <bjorn@bringert.net> | 2008-05-28 15:10:36 +0000 |
| commit | 3fd1f5652a3af22e90a040a821d244a91a3553a0 (patch) | |
| tree | 15225df670e1fb1c55f4a9eb1ca45eae7952061f /src-3.0/GF/Infra/UseIO.hs | |
| parent | 1bc74749aa7a9ec6ecfced68c0cdf38f43c7f9ef (diff) | |
Switch to new options handling.
This changes lots of stuff, let me know if it broke anything.
Comments:
- We use a local hacked version of GetOpt that allows long forms of commands to start with a single dash. This breaks other parts of GetOpt. For example, arguments to short options now require a =, and does not allo pace after the option character.
- The new command parsing is currently only used for the program command line, pragmas and the arguments for the 'i' shell command.
- I made a quick hack for the options for showTerm, which currently makes it impossible to use the print style flags for cc. This will be replaced by a facility for parsing command-specific options.
- The verbosity handling is broken in some places. I will fix that in a later patch.
Diffstat (limited to 'src-3.0/GF/Infra/UseIO.hs')
| -rw-r--r-- | src-3.0/GF/Infra/UseIO.hs | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/src-3.0/GF/Infra/UseIO.hs b/src-3.0/GF/Infra/UseIO.hs index ee66ddcff..dcc0c62ca 100644 --- a/src-3.0/GF/Infra/UseIO.hs +++ b/src-3.0/GF/Infra/UseIO.hs @@ -24,6 +24,7 @@ import System.FilePath import System.IO import System.IO.Error import System.Environment +import System.Exit import System.CPUTime import Control.Monad import Control.Exception(evaluate) @@ -39,20 +40,16 @@ putShow' f = putStrLn . show . length . show . f putIfVerb :: Options -> String -> IO () putIfVerb opts msg = - if oElem beVerbose opts + if beVerbose opts then putStrLn msg else return () putIfVerbW :: Options -> String -> IO () putIfVerbW opts msg = - if oElem beVerbose opts + if beVerbose opts then putStr (' ' : msg) else return () --- | obsolete with IOE monad -errIO :: a -> Err a -> IO a -errIO = errOptIO noOptions - errOptIO :: Options -> a -> Err a -> IO a errOptIO os e m = case m of Ok x -> return x @@ -235,6 +232,13 @@ foldIOE f s xs = case xs of Ok v -> foldIOE f v xx Bad m -> return $ (s, Just m) +dieIOE :: IOE a -> IO a +dieIOE x = appIOE x >>= err die return + +die :: String -> IO a +die s = do hPutStrLn stderr s + exitFailure + putStrLnE :: String -> IOE () putStrLnE = ioeIO . putStrLnFlush @@ -243,28 +247,27 @@ putStrE = ioeIO . putStrFlush -- this is more verbose putPointE :: Options -> String -> IOE a -> IOE a -putPointE = putPointEgen (oElem beSilent) +putPointE = putPointEgen beSilent -- this is less verbose putPointEsil :: Options -> String -> IOE a -> IOE a -putPointEsil = putPointEgen (not . oElem beVerbose) +putPointEsil = putPointEgen (not . beVerbose) putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a putPointEgen cond opts msg act = do - let ve x = if cond opts then return () else x - ve $ ioeIO $ putStrFlush msg + when (cond opts) $ ioeIO $ putStrFlush msg t1 <- ioeIO $ getCPUTime a <- act >>= ioeIO . evaluate t2 <- ioeIO $ getCPUTime - ve $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec") + when (flag optShowCPUTime opts) $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec") return a -- | forces verbosity putPointEVerb :: Options -> String -> IOE a -> IOE a -putPointEVerb opts = putPointE (addOption beVerbose opts) +putPointEVerb = putPointEgen (const False) -- ((do {s <- readFile f; return (return s)}) ) readFileIOE :: FilePath -> IOE BS.ByteString |
