{-# LINE 1 "Database/HDBC/MySQL/RTS.hsc" #-}
{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}
{-# LINE 2 "Database/HDBC/MySQL/RTS.hsc" #-}

module Database.HDBC.MySQL.RTS (withRTSSignalsBlocked) where

import Control.Concurrent (runInBoundThread)
import Control.Exception (finally)
import Foreign.C.Types (CInt(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable(..))


{-# LINE 13 "Database/HDBC/MySQL/RTS.hsc" #-}

-- | Execute an 'IO' action with signals used by GHC's runtime signals
-- blocked.  The @mysqlclient@ C library does not correctly restart
-- system calls if they are interrupted by signals, so many MySQL API
-- calls can unexpectedly fail when called from a Haskell application.
-- This is most likely to occur if you are linking against GHC's
-- threaded runtime (using the @-threaded@ option).
--
-- This function blocks @SIGALRM@ and @SIGVTALRM@, runs your action,
-- then unblocks those signals.  If you have a series of HDBC calls
-- that may block for a period of time, it may be wise to wrap them in
-- this action.  Blocking and unblocking signals is cheap, but not
-- free.
--
-- Here is an example of an exception that could be avoided by
-- temporarily blocking GHC's runtime signals:
--
-- >  SqlError {
-- >    seState = "", 
-- >    seNativeError = 2003, 
-- >    seErrorMsg = "Can't connect to MySQL server on 'localhost' (4)"
-- >  }
withRTSSignalsBlocked :: IO a -> IO a
withRTSSignalsBlocked act = runInBoundThread . alloca $ \set -> do
  sigemptyset set
  sigaddset set (14)
{-# LINE 39 "Database/HDBC/MySQL/RTS.hsc" #-}
  sigaddset set (26)
{-# LINE 40 "Database/HDBC/MySQL/RTS.hsc" #-}
  pthread_sigmask (0) set nullPtr
{-# LINE 41 "Database/HDBC/MySQL/RTS.hsc" #-}
  act `finally` pthread_sigmask (1) set nullPtr
{-# LINE 42 "Database/HDBC/MySQL/RTS.hsc" #-}

data SigSet

instance Storable SigSet where
    sizeOf    _ = (128)
{-# LINE 47 "Database/HDBC/MySQL/RTS.hsc" #-}
    alignment _ = alignment (undefined :: Ptr CInt)

foreign import ccall unsafe "signal.h sigaddset" sigaddset
    :: Ptr SigSet -> CInt -> IO ()

foreign import ccall unsafe "signal.h sigemptyset" sigemptyset
    :: Ptr SigSet -> IO ()

foreign import ccall unsafe "signal.h pthread_sigmask" pthread_sigmask
    :: CInt -> Ptr SigSet -> Ptr SigSet -> IO ()