-- 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/Platform.chs" #-}
{-# LANGUAGE ForeignFunctionInterface, NoMonomorphismRestriction #-}
-- |
-- Module      : Foreign.OpenCL.Bindings.Platform
-- Copyright   : (c) 2011, Martin Dybdal
-- License     : BSD3
-- 
-- Maintainer  : Martin Dybdal <dybber@dybber.dk>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- OpenCL bindings for querying a list of available platforms and
-- information about those platforms. See section 4.1 in the OpenCL
-- specification

module Foreign.OpenCL.Bindings.Platform (
  getPlatformIDs,

  platformProfile, platformVersion, platformName,
  platformVendor, platformExtensions
  )
where



import Foreign.C.Types
import Foreign.Ptr

import Foreign.OpenCL.Bindings.Internal.Types
{-# LINE 28 "./Foreign/OpenCL/Bindings/Platform.chs" #-}

import Foreign.OpenCL.Bindings.Internal.Error
import Foreign.OpenCL.Bindings.Internal.Util
import qualified Foreign.OpenCL.Bindings.Internal.Logging as Log

-- | Obtain a list of available OpenCL platforms.
getPlatformIDs :: IO [PlatformID]
getPlatformIDs = do
  Log.debug "Invoking clGetPlatformIDs"
  getList clGetPlatformIDs_

-- | OpenCL profile string. See CL_PLATFORM_PROFILE in the OpenCL
-- specification for full documentation.
platformProfile :: PlatformID -> IO String
platformProfile pid = getPlatformInfo PlatformProfile pid

-- | OpenCL version string. See CL_PLATFORM_VERSION in the
-- OpenCL specification for full documentation.
platformVersion :: PlatformID -> IO String
platformVersion pid = getPlatformInfo PlatformVersion pid

-- | OpenCL name string
platformName :: PlatformID -> IO String
platformName pid = getPlatformInfo PlatformName pid

-- | OpenCL vendor string
platformVendor :: PlatformID -> IO String
platformVendor pid = getPlatformInfo PlatformVendor pid

-- | OpenCL extensions. Extensions defined here are supported by all
-- devices associated with this platform.
platformExtensions :: PlatformID -> IO [String]
platformExtensions pid = words `fmap` getPlatformInfo PlatformExtensions pid


-- Interfacing functions that performs error checking
getPlatformInfo info platform =
  getInfo (clGetPlatformInfo_ platform) info

clGetPlatformIDs_ num_entries platforms num_platforms = do
  checkClError "clGetPlatformIDs" =<< 
    clGetPlatformIDs num_entries platforms num_platforms

clGetPlatformInfo_ platform name size value size_ret = do
  checkClError "clGetPlatformInfo" =<<
    clGetPlatformInfo platform name size value size_ret


foreign import ccall unsafe "Foreign/OpenCL/Bindings/Platform.chs.h clGetPlatformIDs"
  clGetPlatformIDs :: (CUInt -> ((Ptr (PlatformID)) -> ((Ptr CUInt) -> (IO CInt))))

foreign import ccall unsafe "Foreign/OpenCL/Bindings/Platform.chs.h clGetPlatformInfo"
  clGetPlatformInfo :: ((PlatformID) -> (CUInt -> (CULong -> ((Ptr ()) -> ((Ptr CULong) -> (IO CInt))))))