module Util.Debug(
debug,
debugAct,
(@:),
alwaysDebug,
alwaysDebugAct,
debugString,
(@@:),
wrapError,
) where
import System.IO as IO
import System.IO.Error as IO
import System.IO.Unsafe
import Control.Exception
import Util.WBFiles
openDebugFile :: IO (Maybe Handle)
openDebugFile =
do
debugFileName <- getDebugFileName
IO.catch (
do
handle <- openFile debugFileName WriteMode
hSetBuffering handle NoBuffering
return (Just handle)
)
(\ _-> 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 <- Control.Exception.try act
case res of
Left error ->
do
debug ("Debug.debug caught "++mess)
throw error
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 <- Control.Exception.try act
case res of
Left error ->
do
alwaysDebug ("AlwaysDebug.debug caught "++mess)
throw error
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 =
Control.Exception.catchJust errorCalls (value `seq` return value)
(\ mess -> error (str++":"++mess))