module Util.Debug(
debug,
debugAct,
(@:),
alwaysDebug,
alwaysDebugAct,
debugString,
(@@:),
wrapError,
) where
import System.IO as IO
import System.IO.Unsafe
import Control.Exception as Exception
import Util.WBFiles
openDebugFile :: IO (Maybe Handle)
openDebugFile =
do
debugFileName <- getDebugFileName
Exception.catch (
do
handle <- openFile debugFileName WriteMode
hSetBuffering handle NoBuffering
return (Just handle)
)
(\ (_ :: IOException) -> return Nothing)
debugFile = unsafePerformIO openDebugFile
debugFile :: Maybe Handle
#ifdef DEBUG
debugString s =
case debugFile of
Just f -> IO.hPutStr f s
Nothing -> return ()
debug s =
case debugFile of
Just f -> IO.hPutStrLn f (show s)
Nothing -> return ()
debugAct mess act =
do
res <- Exception.try act
case res of
Left error ->
do
debug ("Debug.debug caught "++mess)
throw (error :: SomeException)
Right success -> return success
#else
debugString _ = return ()
debug _ = return ()
debugAct _ act = act
#endif
debug :: Show a => a -> IO()
debugString :: String -> IO ()
debugAct :: String -> IO a -> IO a
(@:) :: String -> IO a -> IO a
(@:) = debugAct
alwaysDebug :: Show a => a -> IO()
alwaysDebug s =
case debugFile of
Just f -> IO.hPutStrLn f (show s)
Nothing -> return ()
alwaysDebugAct :: String -> IO a -> IO a
alwaysDebugAct mess act =
do
res <- Exception.try act
case res of
Left error ->
do
alwaysDebug ("AlwaysDebug.debug caught "++mess)
throw (error :: SomeException)
Right success -> return success
(@@:) :: String -> IO a -> IO a
(@@:) = alwaysDebugAct
wrapError :: String -> a -> a
#ifdef DEBUG
wrapError str value = unsafePerformIO (wrapErrorIO str value)
#else
wrapError str value = value
#endif
wrapErrorIO :: String -> a -> IO a
wrapErrorIO str value =
Exception.catch (value `seq` return value)
(\ mess -> error (str ++ ":"++ show (mess :: ErrorCall)))