summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra/UseIO.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Infra/UseIO.hs')
-rw-r--r--src/compiler/GF/Infra/UseIO.hs26
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