-- GENERATED by C->Haskell Compiler, version 0.16.6 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/OpenCL/Bindings/Event.chs" #-}
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
-- |
-- Module      : Foreign.OpenCL.Bindings.Event
-- Copyright   : (c) 2011, Martin Dybdal
-- License     : BSD3
-- 
-- Maintainer  : Martin Dybdal <dybber@dybber.dk>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- 
-- OpenCL event handling.

module Foreign.OpenCL.Bindings.Event (
   createUserEvent, waitForEvents,

   eventCommandQueue, eventContext, eventCommandType,
   
   setEventCompleteCallback, setUserEventStatus
  ) where



import Control.Monad

import Foreign
import Foreign.C.Types

import Foreign.OpenCL.Bindings.Internal.Types
{-# LINE 29 "./Foreign/OpenCL/Bindings/Event.chs" #-}

import Foreign.OpenCL.Bindings.Internal.Finalizers
import Foreign.OpenCL.Bindings.Internal.Error
import Foreign.OpenCL.Bindings.Internal.Util

-- |Create a new user event
createUserEvent :: Context
                -> IO Event -- ^The newly created event
createUserEvent context =
  withForeignPtr context $ \ctx ->
  alloca $ \ep -> do
    event <- clCreateUserEvent ctx ep
    checkClError_ "clCreateUserEvent" =<< peek ep
    attachFinalizer event

getEventInfo event info =
    withForeignPtr event $ \event_ptr ->
    getInfo (clGetEventInfo_ event_ptr) info

-- | The 'CommandQueue' associated with an 'Event'
eventCommandQueue :: Event -> IO CommandQueue
eventCommandQueue ev = 
  getEventInfo ev EventCommandQueue >>= attachRetainFinalizer

-- | The 'Context' associated with an 'Event'
eventContext :: Event -> IO Context
eventContext ev = 
  getEventInfo ev EventContext >>= attachRetainFinalizer

-- | The 'CommandType' of an 'Event'
eventCommandType :: Event -> IO CommandType
eventCommandType ev = liftM toEnum $ getEventInfo ev EventCommandType

-- | The OpenCL standard version 1.1 (page 146) mentions CL_COMPLETE
-- as the only command execution callback types where a callback can
-- be registered. This is the callback set by this function.
setEventCompleteCallback :: Storable a => Event -> a -> (CommandExecStatus -> a -> IO ()) -> IO ()
setEventCompleteCallback event user_data callbackfn =
  withForeignPtr event $ \event_ptr ->
  with user_data $ \user_data_ptr -> do
    let ud_ptr = castPtr user_data_ptr :: Ptr ()
    cb_ptr <- wrapCallback callback
    err <- clSetEventCallback event_ptr (fromIntegral $ fromEnum Complete) cb_ptr ud_ptr
    checkClError_ "clSetEventCallback" err
      where
        -- We throw away the Event, as the event should be stored in the
        -- closure of the callback function if necessary
        callback :: Ptr CEvent -> CInt -> Ptr () -> IO ()
        callback _ status user_data_ptr = do
          udata <- peek (castPtr user_data_ptr)
          callbackfn (toEnum $ fromIntegral status) udata
      
-- TODO the second argument should be specified through a datatype
setUserEventStatus :: Event -> Int -> IO ()
setUserEventStatus event execution_status =
  withForeignPtr event $ \event_ptr -> do
    err <- clSetUserEventStatus event_ptr (fromIntegral execution_status)
    checkClError_ "clSetUserEventStatus" err
  
foreign import CALLCONV "wrapper" wrapCallback :: 
                (Ptr CEvent -> CInt -> Ptr () -> IO ())
  -> IO (FunPtr (Ptr CEvent -> CInt -> Ptr () -> IO ()))


-- | Waits on the host thread for commands identified by event objects
-- in event_list to complete. A command is considered complete if its
-- execution status is CL_COMPLETE or a negative value.
waitForEvents :: [Event] -> IO ()
waitForEvents events =
  withForeignPtrs events $ \event_ptrs ->
  withArrayLen event_ptrs $ \n event_array -> do
    checkClError_ "clWaitForEvents" =<<
      clWaitForEvents (fromIntegral n) event_array

-- C interfacing functions
clGetEventInfo_ = 
  checkClError5 "clGetEventInfo" clGetEventInfo
{-# LINE 105 "./Foreign/OpenCL/Bindings/Event.chs" #-}



foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clCreateUserEvent"
  clCreateUserEvent :: ((Ptr (CContext)) -> ((Ptr CInt) -> (IO (Ptr (CEvent)))))

foreign import ccall safe "Foreign/OpenCL/Bindings/Event.chs.h clSetEventCallback"
  clSetEventCallback :: ((Ptr (CEvent)) -> (CInt -> ((FunPtr ((Ptr (CEvent)) -> (CInt -> ((Ptr ()) -> (IO ()))))) -> ((Ptr ()) -> (IO CInt)))))

foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clSetUserEventStatus"
  clSetUserEventStatus :: ((Ptr (CEvent)) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clWaitForEvents"
  clWaitForEvents :: (CUInt -> ((Ptr (Ptr (CEvent))) -> (IO CInt)))

foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clGetEventInfo"
  clGetEventInfo :: ((Ptr (CEvent)) -> (CUInt -> (CULong -> ((Ptr ()) -> ((Ptr CULong) -> (IO CInt))))))