mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
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.
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user