From 3fd1f5652a3af22e90a040a821d244a91a3553a0 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Wed, 28 May 2008 15:10:36 +0000
Subject: 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.
---
 src-3.0/GF/Infra/UseIO.hs | 27 +++++++++++++++------------
 1 file changed, 15 insertions(+), 12 deletions(-)

(limited to 'src-3.0/GF/Infra/UseIO.hs')

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
-- 
cgit v1.2.3