diff options
Diffstat (limited to 'src/compiler/GF/Infra/UseIO.hs')
| -rw-r--r-- | src/compiler/GF/Infra/UseIO.hs | 26 |
1 files changed, 17 insertions, 9 deletions
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index 6de68bc44..e0477c1fc 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -12,7 +12,9 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module GF.Infra.UseIO(module GF.Infra.UseIO,MonadIO(..),liftErr) where +module GF.Infra.UseIO(module GF.Infra.UseIO,liftErr, + -- ** Reused + MonadIO(..),liftErr) where import Prelude hiding (catch) @@ -38,6 +40,8 @@ import Control.Exception(evaluate) --putIfVerb :: MonadIO io => Options -> String -> io () putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg +-- ** GF files path and library path manipulation + type FileName = String type InitPath = String -- ^ the directory portion of a pathname type FullPath = String @@ -119,7 +123,7 @@ splitInModuleSearchPath s = case break isPathSep s of -- --- * IO monad with error; adapted from state monad +-- ** IO monad with error; adapted from state monad newtype IOE a = IOE { appIOE :: IO (Err a) } @@ -165,6 +169,8 @@ die :: String -> IO a die s = do hPutStrLn stderr s exitFailure +-- ** Diagnostic output + class Monad m => Output m where ePutStr, ePutStrLn, putStrE, putStrLnE :: String -> m () @@ -195,13 +201,21 @@ putPointE v opts msg act = do return a +-- | Because GHC adds the confusing text "user error" for failures caused by +-- calls to fail. +ioErrorText e = if isUserError e + then ioeGetErrorString e + else show e + +-- ** Timing + timeIt act = do t1 <- liftIO $ getCPUTime a <- liftIO . evaluate =<< act t2 <- liftIO $ getCPUTime return (t2-t1,a) --- * File IO +-- ** File IO writeUTF8File :: FilePath -> String -> IO () writeUTF8File fpath content = @@ -210,9 +224,3 @@ writeUTF8File fpath content = readBinaryFile path = hGetContents =<< openBinaryFile path ReadMode writeBinaryFile path s = withBinaryFile path WriteMode (flip hPutStr s) - --- | Because GHC adds the confusing text "user error" for failures caused by --- calls to fail. -ioErrorText e = if isUserError e - then ioeGetErrorString e - else show e |
