KiCS-0.8.4: src/SafeCalls.hs

{-# OPTIONS -cpp  #-} 
module SafeCalls(SafeIO, safeSystem, safeIO, safeIOSeq, safe) where

import Control.Monad.Error


#if __GLASGOW_HASKELL__ >= 610
import Control.OldException 
#else
import Control.Exception 
#endif

import Prelude hiding (catch)
import System

--------------------
-- safe calls
--------------------

type SafeIO = ErrorT String IO

safeSystem :: Bool -> String -> SafeIO ()
safeSystem _ "" = return ()
safeSystem verbose sysCall = do
  when verbose $ liftIO $ putStrLn sysCall
  ec <- liftIO $ system sysCall
  if ec==ExitSuccess then return () else fail ("safeSystem: "++show ec)

safeIO :: IO a -> SafeIO a
safeIO action = foo (liftM Right action)

safeIOSeq :: IO a -> SafeIO a
safeIOSeq action = foo (action >>= \x -> seq x (return (Right x)))

foo :: IO (Either String a) -> SafeIO a
foo x = liftIO (catch x putErr) >>= either fail return


safe :: SafeIO a -> IO (Either String a)
safe = runErrorT 

putErr :: Show a => a -> IO (Either String b)
putErr e = putStrLn ("IO action failed: "++show e) >> 
           return (Left $ "SafeCalls.putErr: " ++ show e)