gio: System.GIO.File: add more functions; make the functions that do no IO use unsafePerformIO

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GIO, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GIO documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File (
    File,
    FileClass,
    FileQueryInfoFlags,
    FileCreateFlags,
    FileCopyFlags,
    FileMonitorFlags,
    FilesystemPreviewType,
    FileProgressCallback,
    FileReadMoreCallback,
    fileFromPath,
    fileFromURI,
    fileFromCommandlineArg,
    fileFromParseName,
    fileEqual,
    fileBasename,
    filePath,
    fileURI,
    fileParseName,
    fileGetChild,
    fileGetChildForDisplayName,
    fileHasPrefix,
    fileGetRelativePath,
    fileResolveRelativePath,
    fileIsNative,
    fileHasURIScheme,
    fileURIScheme,
    fileRead,
    fileReadAsync,
    fileReadFinish,
    fileAppendTo,
    fileCreate,
    fileReplace,
    fileAppendToAsync,
    fileAppendToFinish,
    fileCreateAsync,
    fileCreateFinish,
    fileReplaceAsync,
    fileReplaceFinish,
    fileQueryInfo,
    fileQueryInfoAsync,
    fileQueryInfoFinish,
    fileQueryExists,
    fileQueryFilesystemInfo,
    fileQueryFilesystemInfoAsync,
    fileQueryFilesystemInfoFinish,
    fileQueryDefaultHandler,
    fileFindEnclosingMount,
    fileFindEnclosingMountAsync,
    fileFindEnclosingMountFinish,
    fileEnumerateChildren,
    fileEnumerateChildrenAsync,
    fileEnumerateChildrenFinish,
    fileSetDisplayName,
    fileSetDisplayNameAsync,
    fileSetDisplayNameFinish,
    fileDelete,
    fileTrash,
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = {# type goffset #} -> {# type goffset #} -> IO ()
type FileReadMoreCallback = BS.ByteString -> IO Bool

fileFromPath :: FilePath -> File
fileFromPath path =
    unsafePerformIO $ withUTFString path $ {# call file_new_for_path #} >=> takeGObject

fileFromURI :: String -> File
fileFromURI uri =
    unsafePerformIO $ withUTFString uri $ {# call file_new_for_uri #} >=> takeGObject

fileFromCommandlineArg :: String -> File
fileFromCommandlineArg arg =
    unsafePerformIO $ withUTFString arg $ {# call file_new_for_commandline_arg #} >=> takeGObject

fileFromParseName :: String -> File
fileFromParseName parseName =
    unsafePerformIO $ withUTFString parseName $ {# call file_parse_name #} >=> takeGObject

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> Bool
fileEqual file1 file2 =
    unsafePerformIO $ liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

instance Eq File where
    (==) = fileEqual

fileBasename :: FileClass file => file -> String
fileBasename =
    unsafePerformIO . ({# call file_get_basename #} . toFile >=> readUTFString)

filePath :: FileClass file => file -> FilePath
filePath =
    unsafePerformIO . ({# call file_get_path #} . toFile >=> readUTFString)

fileURI :: FileClass file => file -> String
fileURI =
    unsafePerformIO . ({# call file_get_uri #} . toFile >=> readUTFString)

fileParseName :: FileClass file => file -> String
fileParseName =
    unsafePerformIO . ({# call file_get_parse_name #} . toFile >=> readUTFString)

fileParent :: FileClass file => file -> Maybe File
fileParent =
    unsafePerformIO . ({# call file_get_parent #} . toFile >=> maybePeek takeGObject)

fileGetChild :: FileClass file => file -> String -> File
fileGetChild file name =
    unsafePerformIO $
        withUTFString name $
        {# call file_get_child #} (toFile file) >=> takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> Maybe File
fileGetChildForDisplayName file displayName =
    unsafePerformIO $
        withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        maybePeek takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> Bool
fileHasPrefix file1 file2 =
    unsafePerformIO $
        liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> Maybe FilePath
fileGetRelativePath file1 file2 =
    unsafePerformIO $
        {# call file_get_relative_path #} (toFile file1) (toFile file2) >>=
        maybePeek readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> Maybe File
fileResolveRelativePath file relativePath =
    unsafePerformIO $
        withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> Bool
fileIsNative =
    unsafePerformIO .
        liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> Bool
fileHasURIScheme file uriScheme =
    unsafePerformIO $
        withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileURIScheme :: FileClass file => file -> String
fileURIScheme =
    unsafePerformIO . ({# call file_get_uri_scheme #} . toFile >=> readUTFString)

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryInfoFinish :: FileClass file
                    => file
                    -> AsyncResult
                    -> IO FileInfo
fileQueryInfoFinish file asyncResult =
    propagateGError ({#call file_query_info_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}

fileQueryFilesystemInfoAsync :: FileClass file
                             => file
                             -> String
                             -> Int
                             -> Maybe Cancellable
                             -> AsyncReadyCallback
                             -> IO ()
fileQueryFilesystemInfoAsync file attributes ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_filesystem_info_async cFile
                                             cAttributes
                                             (fromIntegral ioPriority)
                                             cCancellable
                                             cCallback
                                             (castFunPtrToPtr cCallback)
    where _ = {# call file_query_filesystem_info_async #}

fileQueryFilesystemInfoFinish :: FileClass file
                              => file
                              -> AsyncResult
                              -> IO FileInfo
fileQueryFilesystemInfoFinish file asyncResult =
    propagateGError ({# call file_query_filesystem_info_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileQueryDefaultHandler :: FileClass file
                        => file
                        -> Maybe Cancellable
                        -> IO AppInfo
fileQueryDefaultHandler file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_default_handler cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_query_default_handler #}

fileFindEnclosingMount :: FileClass file
                       => file
                       -> Maybe Cancellable
                       -> IO Mount
fileFindEnclosingMount file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_find_enclosing_mount cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_find_enclosing_mount #}

fileFindEnclosingMountAsync :: FileClass file
                            => file
                            -> Int
                            -> Maybe Cancellable
                            -> AsyncReadyCallback
                            -> IO ()
fileFindEnclosingMountAsync file ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_find_enclosing_mount_async cFile
                                            (fromIntegral ioPriority)
                                            cCancellable
                                            cCallback
                                            (castFunPtrToPtr cCallback)
    where _ = {# call file_find_enclosing_mount_async #}

fileFindEnclosingMountFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO Mount
fileFindEnclosingMountFinish file asyncResult =
    propagateGError ({# call file_find_enclosing_mount_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileEnumerateChildren :: FileClass file
                      => file
                      -> String
                      -> [FileQueryInfoFlags]
                      -> Maybe Cancellable
                      -> IO FileEnumerator
fileEnumerateChildren file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_enumerate_children cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_enumerate_children #}

fileEnumerateChildrenAsync :: FileClass file
                           => file
                           -> String
                           -> [FileQueryInfoFlags]
                           -> Int
                           -> Maybe Cancellable
                           -> AsyncReadyCallback
                           -> IO ()
fileEnumerateChildrenAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_enumerate_children_async cFile
                                          cAttributes
                                          (cFromFlags flags)
                                          (fromIntegral ioPriority)
                                          cCancellable
                                          cCallback
                                          (castFunPtrToPtr cCallback)
    where _ = {# call file_enumerate_children_async #}

fileEnumerateChildrenFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO FileEnumerator
fileEnumerateChildrenFinish file asyncResult =
    propagateGError ({# call file_enumerate_children_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileSetDisplayName :: FileClass file
                   => file
                   -> String
                   -> Maybe Cancellable
                   -> IO File
fileSetDisplayName file displayName cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_set_display_name cFile cDisplayName cCancellable) >>=
        takeGObject
    where _ = {# call file_set_display_name #}

fileSetDisplayNameAsync :: FileClass file
                        => file
                        -> String
                        -> Int
                        -> Maybe Cancellable
                        -> AsyncReadyCallback
                        -> IO ()
fileSetDisplayNameAsync file displayName ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_set_display_name_async cFile
                                        cDisplayName
                                        (fromIntegral ioPriority)
                                        cCancellable
                                        cCallback
                                        (castFunPtrToPtr cCallback)
    where _ = {# call file_set_display_name_async #}

fileSetDisplayNameFinish :: FileClass file
                         => file
                         -> AsyncResult
                         -> IO File
fileSetDisplayNameFinish file asyncResult =
    propagateGError ({# call file_set_display_name_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileDelete :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileDelete file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_delete cFile cCancellable) >> return ()
    where _ = {# call file_delete #}

fileTrash :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileTrash file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_trash cFile cCancellable) >> return ()
    where _ = {# call file_trash #}

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GIO, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GIO documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File (
    File,
    FileClass,
    FileQueryInfoFlags,
    FileCreateFlags,
    FileCopyFlags,
    FileMonitorFlags,
    FilesystemPreviewType,
    FileProgressCallback,
    FileReadMoreCallback,
    fileNewForPath,
    fileNewForURI,
    fileNewForCommandlineArg,
    fileParseName,
    fileDup,
    fileEqual,
    fileGetBasename,
    fileGetPath,
    fileGetURI,
    fileGetParseName,
    fileGetChild,
    fileGetChildForDisplayName,
    fileHasPrefix,
    fileGetRelativePath,
    fileResolveRelativePath,
    fileIsNative,
    fileHasURIScheme,
    fileGetURIScheme,
    fileRead,
    fileReadAsync,
    fileReadFinish,
    fileAppendTo,
    fileCreate,
    fileReplace,
    fileAppendToAsync,
    fileAppendToFinish,
    fileCreateAsync,
    fileCreateFinish,
    fileReplaceAsync,
    fileReplaceFinish,
    fileQueryInfo,
    fileQueryInfoAsync,
    fileQueryExists,
    fileQueryFilesystemInfo
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = {# type goffset #} -> {# type goffset #} -> IO ()
type FileReadMoreCallback = BS.ByteString -> IO Bool

fileNewForPath :: FilePath -> IO File
fileNewForPath path =
    withUTFString path $ {# call file_new_for_path #} >=> takeGObject

fileNewForURI :: String -> IO File
fileNewForURI uri =
    withUTFString uri $ {# call file_new_for_uri #} >=> takeGObject

fileNewForCommandlineArg :: String -> IO File
fileNewForCommandlineArg arg =
    withUTFString arg $ {# call file_new_for_commandline_arg #} >=> takeGObject

fileParseName :: String -> IO File
fileParseName parseName =
    withUTFString parseName $ {# call file_parse_name #} >=> takeGObject

fileDup :: FileClass file
        => file -> IO file
fileDup =
    {# call file_dup #} . toFile >=> takeGObject . castPtr

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> IO Bool
fileEqual file1 file2 =
    liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

fileGetBasename :: FileClass file => file -> IO String
fileGetBasename =
    {# call file_get_basename #} . toFile >=> readUTFString

fileGetPath :: FileClass file => file -> IO FilePath
fileGetPath =
    {# call file_get_path #} . toFile >=> readUTFString

fileGetURI :: FileClass file => file -> IO String
fileGetURI =
    {# call file_get_uri #} . toFile >=> readUTFString

fileGetParseName :: FileClass file => file -> IO String
fileGetParseName =
    {# call file_get_parse_name #} . toFile >=> readUTFString

fileGetParent :: FileClass file => file -> IO (Maybe File)
fileGetParent =
    {# call file_get_parent #} . toFile >=> maybePeek takeGObject

fileGetChild :: FileClass file => file -> String -> IO (Maybe File)
fileGetChild file name =
    withUTFString name $ {# call file_get_child #} (toFile file) >=> maybePeek takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> IO File
fileGetChildForDisplayName file displayName =
    withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO Bool
fileHasPrefix file1 file2 =
    liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO FilePath
fileGetRelativePath file1 file2 =
    {# call file_get_relative_path #} (toFile file1) (toFile file2) >>= readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> IO (Maybe File)
fileResolveRelativePath file relativePath =
    withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> IO Bool
fileIsNative =
    liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> IO Bool
fileHasURIScheme file uriScheme =
    withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileGetURIScheme :: FileClass file => file -> IO String
fileGetURIScheme =
    {# call file_get_uri_scheme #} . toFile >=> readUTFString

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}


Fixes

Fixes

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}

#include "git2.h"

module Git2 where

import Data.Primitive
import Foreign
import Foreign.C.String
import Foreign.C.Types

type OffT    = {#type git_off_t#}
type TimeT   = {#type git_time_t#}
type Ptr2Int = Ptr () -> IO CInt

newtype ObjDB      = ObjDB { unODB :: Ptr () }
newtype Repository = Repository { unRepository :: Ptr () }
newtype Index      = Index { unIndex :: Ptr () }

{#enum git_otype as OType {underscoreToCase}#}
{#enum git_rtype as RType {underscoreToCase}#}
{#enum git_repository_pathid as RepositoryPathID {underscoreToCase}#}
{#enum git_error as GitError {underscoreToCase}#}
{#enum git_odb_streammode as ODBStreamMode {underscoreToCase}#}

deriving instance Show GitError

repoIs :: Ptr2Int -> Repository -> IO Bool
repoIs ffi (Repository ptr) = return . toBool =<< ffi ptr

openRepo :: String -> IO (Either GitError Repository)
openRepo path = alloca $ \pprepo -> do
  pstr <- newCString path
  res  <- {#call git_repository_open#} pprepo pstr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

{-
do
  let repo = nullPtr
  pstr <- newCString path
  res <- {#call git_repository_open#} repo pstr
  return $ case res of
             0 -> Right $ Repository repo
             n -> Left . toEnum . fromIntegral $ n
-}
openRepoObjDir :: String -> String -> String -> String -> IO (Either GitError Repository)
openRepoObjDir dir objDir idxFile workTree = undefined -- git_repository_open2

openRepoObjDb :: String -> ObjDB -> String -> String -> IO (Either GitError Repository)
openRepoObjDb dir db idxFile workTree = undefined -- git_repository_open3

-- TODO: size? GIT_EXTERN(int) git_repository_discover(char *repository_path, size_t size, const char *start_path, int across_fs, const char *ceiling_dirs);
discover :: String -> Bool -> String -> IO (Either GitError String)
discover startPath acrossFs ceilingDirs = undefined -- git_repository_discover

database :: Repository -> IO ObjDB
database (Repository r) = return . ObjDB =<< {#call git_repository_database#} r

index :: Repository -> IO (Either GitError Index)
index repo = undefined -- git_repository_index

free :: Repository -> IO ()
free (Repository r) = {#call git_repository_free#} r

init :: String -> Bool -> Either GitError Repository
init path isBare = undefined -- git_repository_init

isHeadDetached :: Repository -> IO Bool
isHeadDetached = repoIs {#call git_repository_head_detached#}

isHeadOrphan :: Repository -> IO Bool
isHeadOrphan = repoIs {#call git_repository_head_orphan#}

isEmpty :: Repository -> IO Bool
isEmpty = repoIs {#call git_repository_is_empty#}

path :: Repository -> RepositoryPathID -> IO String
path (Repository r) pathID = return . undefined =<< {#call git_repository_path#} r (fromIntegral $ fromEnum pathID)

isBare :: Repository -> IO Bool
isBare = repoIs {#call git_repository_is_bare#}

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}

#include "git2.h"

module Git2 where

import Data.Primitive
import Foreign
import Foreign.C.String
import Foreign.C.Types

type OffT    = {#type git_off_t#}
type TimeT   = {#type git_time_t#}
type Ptr2Int = Ptr () -> IO CInt

newtype ObjDB      = ObjDB { unODB :: Ptr () }
newtype Repository = Repository { unRepository :: Ptr () }
newtype Index      = Index { unIndex :: Ptr () }

{#enum git_otype as OType {underscoreToCase}#}
{#enum git_rtype as RType {underscoreToCase}#}
{#enum git_repository_pathid as RepositoryPathID {underscoreToCase}#}
{#enum git_error as GitError {underscoreToCase}#}
{#enum git_odb_streammode as ODBStreamMode {underscoreToCase}#}

deriving instance Show GitError

repoIs :: Ptr2Int -> Repository -> IO Bool
repoIs ffi (Repository ptr) = return . toBool =<< ffi ptr

openRepo :: String -> IO (Either GitError Repository)
openRepo path = do
  pstr <- newCString path
  res <- {#call git_repository_open#} nullPtr pstr
  return $ case res of
             0 -> Right repo
             n -> Left . toEnum . fromIntegral $ n

openRepoObjDir :: String -> String -> String -> String -> IO (Either GitError Repository)
openRepoObjDir dir objDir idxFile workTree = undefined -- git_repository_open2

openRepoObjDb :: String -> ObjDB -> String -> String -> IO (Either GitError Repository)
openRepoObjDb dir db idxFile workTree = undefined -- git_repository_open3

-- TODO: size? GIT_EXTERN(int) git_repository_discover(char *repository_path, size_t size, const char *start_path, int across_fs, const char *ceiling_dirs);
discover :: String -> Bool -> String -> IO (Either GitError String)
discover startPath acrossFs ceilingDirs = undefined -- git_repository_discover

database :: Repository -> IO ObjDB
database (Repository r) = return . ObjDB =<< {#call git_repository_database#} r

index :: Repository -> IO (Either GitError Index)
index repo = undefined -- git_repository_index

free :: Repository -> IO ()
free (Repository r) = {#call git_repository_free#} r

init :: String -> Bool -> Either GitError Repository
init path isBare = undefined -- git_repository_init

isHeadDetached :: Repository -> IO Bool
isHeadDetached = repoIs {#call git_repository_head_detached#}

isHeadOrphan :: Repository -> IO Bool
isHeadOrphan = repoIs {#call git_repository_head_orphan#}

isEmpty :: Repository -> IO Bool
isEmpty = repoIs {#call git_repository_is_empty#}

path :: Repository -> RepositoryPathID -> IO String
path (Repository r) pathID = return . undefined =<< {#call git_repository_path#} r (fromIntegral $ fromEnum pathID)

isBare :: Repository -> IO Bool
isBare = repoIs {#call git_repository_is_bare#}


refs #8: add clCreateImage3D

refs #8: add clCreateImage3D

{- Copyright (c) 2011 Luis Cabellos,

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of  nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module Control.Parallel.OpenCL.Memory(
  -- * Types
  CLMem, CLSampler, CLMemFlag(..), CLMemObjectType(..), CLAddressingMode(..),
  CLFilterMode(..), CLImageFormat(..),
  -- * Memory Functions
  clCreateBuffer, clRetainMemObject, clReleaseMemObject, clGetMemType,
  clGetMemFlags, clGetMemSize, clGetMemHostPtr, clGetMemMapCount,
  clGetMemReferenceCount, clGetMemContext,
  -- * Image Functions
  clCreateImage2D, clCreateImage3D,
  -- * Sampler Functions
  clCreateSampler, clRetainSampler, clReleaseSampler, clGetSamplerReferenceCount,
  clGetSamplerContext, clGetSamplerAddressingMode, clGetSamplerFilterMode,
  clGetSamplerNormalizedCoords
  ) where

-- -----------------------------------------------------------------------------
import Foreign
import Foreign.C.Types
import Control.Applicative( (<$>), (<*>) )
import Control.Parallel.OpenCL.Types(
  CLMem, CLContext, CLSampler, CLint, CLuint, CLbool, CLMemFlags_,
  CLMemInfo_, CLAddressingMode_, CLFilterMode_, CLSamplerInfo_,
  CLAddressingMode(..), CLFilterMode(..), CLMemFlag(..), CLMemObjectType_,
  CLMemObjectType(..),
  wrapPError, wrapCheckSuccess, wrapGetInfo, getEnumCL, bitmaskFromFlags,
  bitmaskToMemFlags, getCLValue )

#ifdef __APPLE__
#include <cl.h>
#else
#include <CL/cl.h>
#endif

-- -----------------------------------------------------------------------------
foreign import CALLCONV "clCreateBuffer" raw_clCreateBuffer ::
  CLContext -> CLMemFlags_ -> CSize -> Ptr () -> Ptr CLint -> IO CLMem
foreign import CALLCONV "clCreateImage2D" raw_clCreateImage2D ::
  CLContext -> CLMemFlags_ -> CLImageFormat_p -> CSize -> CSize -> CSize
  -> Ptr () -> Ptr CLint -> IO CLMem
foreign import CALLCONV "clCreateImage3D" raw_clCreateImage3D ::
  CLContext -> CLMemFlags_-> CLImageFormat_p -> CSize -> CSize -> CSize -> CSize
  -> CSize -> Ptr () -> Ptr CLint -> IO CLMem
foreign import CALLCONV "clRetainMemObject" raw_clRetainMemObject ::
  CLMem -> IO CLint
foreign import CALLCONV "clReleaseMemObject" raw_clReleaseMemObject ::
  CLMem -> IO CLint
--foreign import CALLCONV "clGetSupportedImageFormats" raw_clGetSupportedImageFormats ::
--  CLContext -> CLMemFlags_ -> CLMemObjectType_ -> CLuint -> CLImageFormat_p
--  -> Ptr CLuint -> IO CLint
foreign import CALLCONV "clGetMemObjectInfo" raw_clGetMemObjectInfo ::
  CLMem -> CLMemInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
--foreign import CALLCONV "clGetImageInfo" raw_clGetImageInfo ::
--  CLMem -> CLImageInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
foreign import CALLCONV "clCreateSampler" raw_clCreateSampler ::
  CLContext -> CLbool -> CLAddressingMode_ -> CLFilterMode_ -> Ptr CLint -> IO CLSampler
foreign import CALLCONV "clRetainSampler" raw_clRetainSampler ::
  CLSampler -> IO CLint
foreign import CALLCONV "clReleaseSampler" raw_clReleaseSampler ::
  CLSampler -> IO CLint
foreign import CALLCONV "clGetSamplerInfo" raw_clGetSamplerInfo ::
  CLSampler -> CLSamplerInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint

-- -----------------------------------------------------------------------------
{-| Creates a buffer object. Returns a valid non-zero buffer object if the
buffer object is created successfully. Otherwise, it throws the 'CLError':

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if values specified in flags are not valid.

 * 'CL_INVALID_BUFFER_SIZE' if size is 0 or is greater than
'clDeviceMaxMemAllocSize' value for all devices in context.

 * 'CL_INVALID_HOST_PTR' if host_ptr is NULL and 'CL_MEM_USE_HOST_PTR' or
'CL_MEM_COPY_HOST_PTR' are set in flags or if host_ptr is not NULL but
'CL_MEM_COPY_HOST_PTR' or 'CL_MEM_USE_HOST_PTR' are not set in flags.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for buffer object.

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clCreateBuffer :: Integral a => CLContext -> [CLMemFlag] -> (a, Ptr ()) -> IO CLMem
clCreateBuffer ctx xs (sbuff,buff) = wrapPError $ \perr -> do
  raw_clCreateBuffer ctx flags (fromIntegral sbuff) buff perr
    where
      flags = bitmaskFromFlags xs

-- | Increments the memory object reference count. returns 'True' if the
-- function is executed successfully. After the memobj reference count becomes
-- zero and commands queued for execution on a command-queue(s) that use memobj
-- have finished, the memory object is deleted. It returns 'False' if memobj is
-- not a valid memory object.
clRetainMemObject :: CLMem -> IO Bool
clRetainMemObject mem = wrapCheckSuccess $ raw_clRetainMemObject mem

-- | Decrements the memory object reference count. After the memobj reference
-- count becomes zero and commands queued for execution on a command-queue(s)
-- that use memobj have finished, the memory object is deleted. Returns 'True'
-- if the function is executed successfully. It returns 'False' if memobj is not
-- a valid memory object.
clReleaseMemObject :: CLMem -> IO Bool
clReleaseMemObject mem = wrapCheckSuccess $ raw_clReleaseMemObject mem

-- -----------------------------------------------------------------------------
#c
enum CLChannelOrder {
  cL_R=CL_R,
  cL_A=CL_A,
  cL_INTENSITY=CL_INTENSITY,
  cL_LUMINANCE=CL_LUMINANCE,
  cL_RG=CL_RG,
  cL_RA=CL_RA,
  cL_RGB=CL_RGB,
  cL_RGBA=CL_RGBA,
  cL_ARGB=CL_ARGB,
  cL_BGRA=CL_BGRA,
  };
#endc
{-| Specifies the number of channels and the channel layout i.e. the memory
layout in which channels are stored in the image. Valid values are described in
the table below.

 * 'CL_R', 'CL_A'.

 * 'CL_INTENSITY', This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_UNORM_INT16', 'CL_SNORM_INT8', 'CL_SNORM_INT16',
'CL_HALF_FLOAT', or 'CL_FLOAT'.

 * 'CL_LUMINANCE', This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_UNORM_INT16', 'CL_SNORM_INT8', 'CL_SNORM_INT16',
'CL_HALF_FLOAT', or 'CL_FLOAT'.

 * 'CL_RG', 'CL_RA'.

 * 'CL_RGB', This format can only be used if channel data type =
'CL_UNORM_SHORT_565', 'CL_UNORM_SHORT_555' or 'CL_UNORM_INT101010'.

 * 'CL_RGBA'.

 * 'CL_ARGB', 'CL_BGRA'. This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_SNORM_INT8', 'CL_SIGNED_INT8' or 'CL_UNSIGNED_INT8'.
-}
{#enum CLChannelOrder {upcaseFirstLetter} #}

#c
enum CLChannelType {
  cL_SNORM_INT8=CL_SNORM_INT8,
  cL_SNORM_INT16=CL_SNORM_INT16,
  cL_UNORM_INT8=CL_UNORM_INT8,
  cL_UNORM_INT16=CL_UNORM_INT16,
  cL_UNORM_SHORT_565=CL_UNORM_SHORT_565,
  cL_UNORM_SHORT_555=CL_UNORM_SHORT_555,
  cL_UNORM_INT_101010=CL_UNORM_INT_101010,
  cL_SIGNED_INT8=CL_SIGNED_INT8,
  cL_SIGNED_INT16=CL_SIGNED_INT16,
  cL_SIGNED_INT32=CL_SIGNED_INT32,
  cL_UNSIGNED_INT8=CL_UNSIGNED_INT8,
  cL_UNSIGNED_INT16=CL_UNSIGNED_INT16,
  cL_UNSIGNED_INT32=CL_UNSIGNED_INT32,
  cL_HALF_FLOAT=CL_HALF_FLOAT,
  cL_FLOAT=CL_FLOAT,
  };
#endc
{-| Describes the size of the channel data type. The number of bits per element
determined by the image_channel_data_type and image_channel_order must be a
power of two. The list of supported values is described in the table below.

 * 'CL_SNORM_INT8', Each channel component is a normalized signed 8-bit integer
value.

 * 'CL_SNORM_INT16', Each channel component is a normalized signed 16-bit
integer value.

 * 'CL_UNORM_INT8', Each channel component is a normalized unsigned 8-bit
integer value.

 * 'CL_UNORM_INT16', Each channel component is a normalized unsigned 16-bit
integer value.

 * 'CL_UNORM_SHORT_565', Represents a normalized 5-6-5 3-channel RGB image. The
channel order must be 'CL_RGB'.

 * 'CL_UNORM_SHORT_555', Represents a normalized x-5-5-5 4-channel xRGB
image. The channel order must be 'CL_RGB'.

 * 'CL_UNORM_INT_101010', Represents a normalized x-10-10-10 4-channel xRGB
image. The channel order must be 'CL_RGB'.

 * 'CL_SIGNED_INT8', Each channel component is an unnormalized signed 8-bit
integer value.

 * 'CL_SIGNED_INT16', Each channel component is an unnormalized signed 16-bit
integer value.

 * 'CL_SIGNED_INT32', Each channel component is an unnormalized signed 32-bit
integer value.

 * 'CL_UNSIGNED_INT8', Each channel component is an unnormalized unsigned 8-bit
integer value.

 * 'CL_UNSIGNED_INT16', Each channel component is an unnormalized unsigned
16-bit integer value.

 * 'CL_UNSIGNED_INT32', Each channel component is an unnormalized unsigned
32-bit integer value.

 * 'CL_HALF_FLOAT', Each channel component is a 16-bit half-float value.

 * 'CL_FLOAT', Each channel component is a single precision floating-point
value.
-}
{#enum CLChannelType {upcaseFirstLetter} #}

data CLImageFormat = CLImageFormat
                     { image_channel_order :: ! CLChannelOrder
                     , image_channel_data_type :: ! CLChannelType }
{#pointer *cl_image_format as CLImageFormat_p -> CLImageFormat#}
instance Storable CLImageFormat where
  alignment _ = alignment (undefined :: CDouble)
  sizeOf _ = {#sizeof cl_image_format #}
  peek p =
    CLImageFormat <$> fmap getEnumCL ({#get cl_image_format.image_channel_order #} p)
           <*> fmap getEnumCL ({#get cl_image_format.image_channel_data_type #} p)
  poke p (CLImageFormat a b) = do
    {#set cl_image_format.image_channel_order #} p (getCLValue a)
    {#set cl_image_format.image_channel_data_type #} p (getCLValue b)

-- -----------------------------------------------------------------------------
{-| Creates a 2D image object.

'clCreateImage2D' returns a valid non-zero image object created if the image
object is created successfully. Otherwise, it throws one of the following
'CLError' exceptions:

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if values specified in flags are not valid.

 * 'CL_INVALID_IMAGE_FORMAT_DESCRIPTOR' if values specified in image_format are
not valid.

 * 'CL_INVALID_IMAGE_SIZE' if image_width or image_height are 0 or if they
exceed values specified in 'CL_DEVICE_IMAGE2D_MAX_WIDTH' or
'CL_DEVICE_IMAGE2D_MAX_HEIGHT' respectively for all devices in context or if
values specified by image_row_pitch do not follow rules described in the
argument description above.

 * 'CL_INVALID_HOST_PTR' if host_ptr is 'nullPtr' and 'CL_MEM_USE_HOST_PTR' or
'CL_MEM_COPY_HOST_PTR' are set in flags or if host_ptr is not 'nullPtr' but
'CL_MEM_COPY_HOST_PTR' or 'CL_MEM_USE_HOST_PTR' are not set in flags.

 * 'CL_IMAGE_FORMAT_NOT_SUPPORTED' if the image_format is not supported.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for image object.

 * 'CL_INVALID_OPERATION' if there are no devices in context that support images
(i.e. 'CL_DEVICE_IMAGE_SUPPORT' (specified in the table of OpenCL Device Queries
for 'clGetDeviceInfo') is 'False').

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.

-}

clCreateImage2D :: Integral a => CLContext -- ^ A valid OpenCL context on which
                                           -- the image object is to be created.
                   -> [CLMemFlag] -- ^ A list of flags that is used to specify
                                  -- allocation and usage information about the
                                  -- image memory object being created.
                   -> CLImageFormat -- ^ Structure that describes format
                                    -- properties of the image to be allocated.
                   -> a -- ^ The width of the image in pixels. It must be values
                        -- greater than or equal to 1.
                   -> a -- ^ The height of the image in pixels. It must be
                        -- values greater than or equal to 1.
                   -> a -- ^ The scan-line pitch in bytes. This must be 0 if
                        -- host_ptr is 'nullPtr' and can be either 0 or greater
                        -- than or equal to image_width * size of element in
                        -- bytes if host_ptr is not 'nullPtr'. If host_ptr is
                        -- not 'nullPtr' and image_row_pitch is equal to 0,
                        -- image_row_pitch is calculated as image_width * size
                        -- of element in bytes. If image_row_pitch is not 0, it
                        -- must be a multiple of the image element size in
                        -- bytes.
                   -> Ptr () -- ^ A pointer to the image data that may already
                             -- be allocated by the application. The size of the
                             -- buffer that host_ptr points to must be greater
                             -- than or equal to image_row_pitch *
                             -- image_height. The size of each element in bytes
                             -- must be a power of 2. The image data specified
                             -- by host_ptr is stored as a linear sequence of
                             -- adjacent scanlines. Each scanline is stored as a
                             -- linear sequence of image elements.
                   -> IO CLMem
clCreateImage2D ctx xs fmt iw ih irp ptr = wrapPError $ \perr -> with fmt $ \pfmt -> do
  raw_clCreateImage2D ctx flags pfmt ciw cih cirp ptr perr
    where
      flags = bitmaskFromFlags xs
      ciw = fromIntegral iw
      cih = fromIntegral ih
      cirp = fromIntegral irp

{-| Creates a 3D image object.

'clCreateImage3D' returns a valid non-zero image object created if the image
object is created successfully. Otherwise, it throws one of the following
'CLError' exceptions:

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if values specified in flags are not valid.

 * 'CL_INVALID_IMAGE_FORMAT_DESCRIPTOR' if values specified in image_format are
not valid.

 * 'CL_INVALID_IMAGE_SIZE' if image_width, image_height are 0 or if image_depth
less than or equal to 1 or if they exceed values specified in
'CL_DEVICE_IMAGE3D_MAX_WIDTH', CL_DEVICE_IMAGE3D_MAX_HEIGHT' or
'CL_DEVICE_IMAGE3D_MAX_DEPTH' respectively for all devices in context or if
values specified by image_row_pitch and image_slice_pitch do not follow rules
described in the argument description above.

 * 'CL_INVALID_HOST_PTR' if host_ptr is 'nullPtr' and 'CL_MEM_USE_HOST_PTR' or
'CL_MEM_COPY_HOST_PTR' are set in flags or if host_ptr is not 'nullPtr' but
'CL_MEM_COPY_HOST_PTR' or 'CL_MEM_USE_HOST_PTR' are not set in flags.

 * 'CL_IMAGE_FORMAT_NOT_SUPPORTED' if the image_format is not supported.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for image object.

 * 'CL_INVALID_OPERATION' if there are no devices in context that support images
(i.e. 'CL_DEVICE_IMAGE_SUPPORT' (specified in the table of OpenCL Device Queries
for clGetDeviceInfo) is 'False').

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.

-}
clCreateImage3D :: Integral a => CLContext -- ^ A valid OpenCL context on which
                                           -- the image object is to be created.
                   -> [CLMemFlag] -- ^ A list of flags that is used to specify
                                  -- allocation and usage information about the
                                  -- image memory object being created.
                   -> CLImageFormat -- ^ Structure that describes format
                                    -- properties of the image to be allocated.
                   -> a -- ^ The width of the image in pixels. It must be values
                        -- greater than or equal to 1.
                   -> a -- ^ The height of the image in pixels. It must be
                        -- values greater than or equal to 1.
                   -> a -- ^ The depth of the image in pixels. This must be a
                        -- value greater than 1.
                   -> a -- ^ The scan-line pitch in bytes. This must be 0 if
                        -- host_ptr is 'nullPtr' and can be either 0 or greater
                        -- than or equal to image_width * size of element in
                        -- bytes if host_ptr is not 'nullPtr'. If host_ptr is
                        -- not 'nullPtr' and image_row_pitch is equal to 0,
                        -- image_row_pitch is calculated as image_width * size
                        -- of element in bytes. If image_row_pitch is not 0, it
                        -- must be a multiple of the image element size in
                        -- bytes.
                   -> a -- ^ The size in bytes of each 2D slice in the 3D
                        -- image. This must be 0 if host_ptr is 'nullPtr' and
                        -- can be either 0 or greater than or equal to
                        -- image_row_pitch * image_height if host_ptr is not
                        -- 'nullPtr'. If host_ptr is not 'nullPtr' and
                        -- image_slice_pitch equal to 0, image_slice_pitch is
                        -- calculated as image_row_pitch * image_height. If
                        -- image_slice_pitch is not 0, it must be a multiple of
                        -- the image_row_pitch.
                   -> Ptr () -- ^ A pointer to the image data that may already
                             -- be allocated by the application. The size of the
                             -- buffer that host_ptr points to must be greater
                             -- than or equal to image_slice_pitch *
                             -- image_depth. The size of each element in bytes
                             -- must be a power of 2. The image data specified
                             -- by host_ptr is stored as a linear sequence of
                             -- adjacent 2D slices. Each 2D slice is a linear
                             -- sequence of adjacent scanlines. Each scanline is
                             -- a linear sequence of image elements.
                   -> IO CLMem
clCreateImage3D ctx xs fmt iw ih idepth irp isp ptr = wrapPError $ \perr -> with fmt $ \pfmt -> do
  raw_clCreateImage3D ctx flags pfmt ciw cih cid cirp cisp ptr perr
    where
      flags = bitmaskFromFlags xs
      ciw = fromIntegral iw
      cih = fromIntegral ih
      cid = fromIntegral idepth
      cirp = fromIntegral irp
      cisp = fromIntegral isp
#c
enum CLMemInfo {
  cL_MEM_TYPE=CL_MEM_TYPE,
  cL_MEM_FLAGS=CL_MEM_FLAGS,
  cL_MEM_SIZE=CL_MEM_SIZE,
  cL_MEM_HOST_PTR=CL_MEM_HOST_PTR,
  cL_MEM_MAP_COUNT=CL_MEM_MAP_COUNT,
  cL_MEM_REFERENCE_COUNT=CL_MEM_REFERENCE_COUNT,
  cL_MEM_CONTEXT=CL_MEM_CONTEXT,
  };
#endc
{#enum CLMemInfo {upcaseFirstLetter} #}

-- | Returns the mem object type.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_TYPE'.
clGetMemType :: CLMem -> IO CLMemObjectType
clGetMemType mem =
    wrapGetInfo (\(dat :: Ptr CLMemObjectType_) ->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_MEM_TYPE
      size = fromIntegral $ sizeOf (0::CLMemObjectType_)

-- | Return the flags argument value specified when memobj was created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_FLAGS'.
clGetMemFlags :: CLMem -> IO [CLMemFlag]
clGetMemFlags mem =
    wrapGetInfo (\(dat :: Ptr CLMemFlags_)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) bitmaskToMemFlags
    where
      infoid = getCLValue CL_MEM_FLAGS
      size = fromIntegral $ sizeOf (0::CLMemFlags_)

-- | Return actual size of memobj in bytes.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_SIZE'.
clGetMemSize :: CLMem -> IO CSize
clGetMemSize mem =
    wrapGetInfo (\(dat :: Ptr CSize)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_SIZE
      size = fromIntegral $ sizeOf (0::CSize)

-- | Return the host_ptr argument value specified when memobj is created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_HOST_PTR'.
clGetMemHostPtr :: CLMem -> IO (Ptr ())
clGetMemHostPtr mem =
    wrapGetInfo (\(dat :: Ptr (Ptr ()))->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_HOST_PTR
      size = fromIntegral $ sizeOf (nullPtr::Ptr ())

-- | Map count. The map count returned should be considered immediately
-- stale. It is unsuitable for general use in applications. This feature is
-- provided for debugging.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_MAP_COUNT'.
clGetMemMapCount :: CLMem -> IO CLuint
clGetMemMapCount mem =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_MAP_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return memobj reference count. The reference count returned should be
-- considered immediately stale. It is unsuitable for general use in
-- applications. This feature is provided for identifying memory leaks.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_REFERENCE_COUNT'.
clGetMemReferenceCount :: CLMem -> IO CLuint
clGetMemReferenceCount mem =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return context specified when memory object is created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_CONTEXT'.
clGetMemContext :: CLMem -> IO CLContext
clGetMemContext mem =
    wrapGetInfo (\(dat :: Ptr CLContext)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_CONTEXT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- -----------------------------------------------------------------------------
{-| Creates a sampler object. A sampler object describes how to sample an image
when the image is read in the kernel. The built-in functions to read from an
image in a kernel take a sampler as an argument. The sampler arguments to the
image read function can be sampler objects created using OpenCL functions and
passed as argument values to the kernel or can be samplers declared inside a
kernel. In this section we discuss how sampler objects are created using OpenCL
functions.

Returns a valid non-zero sampler object if the sampler object is created
successfully. Otherwise, it throws one of the following 'CLError' exceptions:

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if addressing_mode, filter_mode, or normalized_coords or a
combination of these argument values are not valid.

 * 'CL_INVALID_OPERATION' if images are not supported by any device associated
with context (i.e. 'CL_DEVICE_IMAGE_SUPPORT' specified in the table of OpenCL
Device Queries for clGetDeviceInfo is 'False').

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clCreateSampler :: CLContext -> Bool -> CLAddressingMode -> CLFilterMode
                   -> IO CLSampler
clCreateSampler ctx norm am fm = wrapPError $ \perr -> do
  raw_clCreateSampler ctx (fromBool norm) (getCLValue am) (getCLValue fm) perr

-- | Increments the sampler reference count. 'clCreateSampler' does an implicit
-- retain. Returns 'True' if the function is executed successfully. It returns
-- 'False' if sampler is not a valid sampler object.
clRetainSampler :: CLSampler -> IO Bool
clRetainSampler mem = wrapCheckSuccess $ raw_clRetainSampler mem

-- | Decrements the sampler reference count. The sampler object is deleted after
-- the reference count becomes zero and commands queued for execution on a
-- command-queue(s) that use sampler have finished. 'clReleaseSampler' returns
-- 'True' if the function is executed successfully. It returns 'False' if
-- sampler is not a valid sampler object.
clReleaseSampler :: CLSampler -> IO Bool
clReleaseSampler mem = wrapCheckSuccess $ raw_clReleaseSampler mem

#c
enum CLSamplerInfo {
  cL_SAMPLER_REFERENCE_COUNT=CL_SAMPLER_REFERENCE_COUNT,
  cL_SAMPLER_CONTEXT=CL_SAMPLER_CONTEXT,
  cL_SAMPLER_ADDRESSING_MODE=CL_SAMPLER_ADDRESSING_MODE,
  cL_SAMPLER_FILTER_MODE=CL_SAMPLER_FILTER_MODE,
  cL_SAMPLER_NORMALIZED_COORDS=CL_SAMPLER_NORMALIZED_COORDS
  };
#endc
{#enum CLSamplerInfo {upcaseFirstLetter} #}

-- | Return the sampler reference count. The reference count returned should be
-- considered immediately stale. It is unsuitable for general use in
-- applications. This feature is provided for identifying memory leaks.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_REFERENCE_COUNT'.
clGetSamplerReferenceCount :: CLSampler -> IO CLuint
clGetSamplerReferenceCount sam =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_SAMPLER_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return the context specified when the sampler is created.
--
-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_CONTEXT'.
clGetSamplerContext :: CLSampler -> IO CLContext
clGetSamplerContext sam =
    wrapGetInfo (\(dat :: Ptr CLContext)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_SAMPLER_CONTEXT
      size = fromIntegral $ sizeOf (nullPtr :: CLContext)

-- | Return the value specified by addressing_mode argument to clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_ADDRESSING_MODE'.
clGetSamplerAddressingMode :: CLSampler -> IO CLAddressingMode
clGetSamplerAddressingMode sam =
    wrapGetInfo (\(dat :: Ptr CLAddressingMode_)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_SAMPLER_ADDRESSING_MODE
      size = fromIntegral $ sizeOf (0 :: CLAddressingMode_)

-- | Return the value specified by filter_mode argument to clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_FILTER_MODE'.
clGetSamplerFilterMode :: CLSampler -> IO CLFilterMode
clGetSamplerFilterMode sam =
    wrapGetInfo (\(dat :: Ptr CLFilterMode_)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_SAMPLER_FILTER_MODE
      size = fromIntegral $ sizeOf (0 :: CLFilterMode_)

-- | Return the value specified by normalized_coords argument to
-- clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_NORMALIZED_COORDS'.
clGetSamplerNormalizedCoords :: CLSampler -> IO Bool
clGetSamplerNormalizedCoords sam =
    wrapGetInfo (\(dat :: Ptr CLbool)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) (/=0)
    where
      infoid = getCLValue CL_SAMPLER_NORMALIZED_COORDS
      size = fromIntegral $ sizeOf (0 :: CLbool)

-- -----------------------------------------------------------------------------

{- Copyright (c) 2011 Luis Cabellos,

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of  nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module Control.Parallel.OpenCL.Memory(
  -- * Types
  CLMem, CLSampler, CLMemFlag(..), CLMemObjectType(..), CLAddressingMode(..),
  CLFilterMode(..), CLImageFormat(..),
  -- * Memory Functions
  clCreateBuffer, clRetainMemObject, clReleaseMemObject, clGetMemType,
  clGetMemFlags, clGetMemSize, clGetMemHostPtr, clGetMemMapCount,
  clGetMemReferenceCount, clGetMemContext,
  -- * Image Functions
  clCreateImage2D,
  -- * Sampler Functions
  clCreateSampler, clRetainSampler, clReleaseSampler, clGetSamplerReferenceCount,
  clGetSamplerContext, clGetSamplerAddressingMode, clGetSamplerFilterMode,
  clGetSamplerNormalizedCoords
  ) where

-- -----------------------------------------------------------------------------
import Foreign
import Foreign.C.Types
import Control.Applicative( (<$>), (<*>) )
import Control.Parallel.OpenCL.Types(
  CLMem, CLContext, CLSampler, CLint, CLuint, CLbool, CLMemFlags_,
  CLMemInfo_, CLAddressingMode_, CLFilterMode_, CLSamplerInfo_,
  CLAddressingMode(..), CLFilterMode(..), CLMemFlag(..), CLMemObjectType_,
  CLMemObjectType(..),
  wrapPError, wrapCheckSuccess, wrapGetInfo, getEnumCL, bitmaskFromFlags,
  bitmaskToMemFlags, getCLValue )

#ifdef __APPLE__
#include <cl.h>
#else
#include <CL/cl.h>
#endif

-- -----------------------------------------------------------------------------
foreign import CALLCONV "clCreateBuffer" raw_clCreateBuffer ::
  CLContext -> CLMemFlags_ -> CSize -> Ptr () -> Ptr CLint -> IO CLMem
foreign import CALLCONV "clCreateImage2D" raw_clCreateImage2D ::
  CLContext -> CLMemFlags_ -> CLImageFormat_p -> CSize -> CSize -> CSize
  -> Ptr () -> Ptr CLint -> IO CLMem
--foreign import CALLCONV "clCreateImage3D" raw_clCreateImage3D ::
--  CLContext -> CLMemFlags_-> CLImageFormat_p -> CSize -> CSize -> CSize -> CSize
--  -> CSize -> Ptr () -> Ptr CLint -> IO CLMem
foreign import CALLCONV "clRetainMemObject" raw_clRetainMemObject ::
  CLMem -> IO CLint
foreign import CALLCONV "clReleaseMemObject" raw_clReleaseMemObject ::
  CLMem -> IO CLint
--foreign import CALLCONV "clGetSupportedImageFormats" raw_clGetSupportedImageFormats ::
--  CLContext -> CLMemFlags_ -> CLMemObjectType_ -> CLuint -> CLImageFormat_p
--  -> Ptr CLuint -> IO CLint
foreign import CALLCONV "clGetMemObjectInfo" raw_clGetMemObjectInfo ::
  CLMem -> CLMemInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
--foreign import CALLCONV "clGetImageInfo" raw_clGetImageInfo ::
--  CLMem -> CLImageInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
foreign import CALLCONV "clCreateSampler" raw_clCreateSampler ::
  CLContext -> CLbool -> CLAddressingMode_ -> CLFilterMode_ -> Ptr CLint -> IO CLSampler
foreign import CALLCONV "clRetainSampler" raw_clRetainSampler ::
  CLSampler -> IO CLint
foreign import CALLCONV "clReleaseSampler" raw_clReleaseSampler ::
  CLSampler -> IO CLint
foreign import CALLCONV "clGetSamplerInfo" raw_clGetSamplerInfo ::
  CLSampler -> CLSamplerInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint

-- -----------------------------------------------------------------------------
{-| Creates a buffer object. Returns a valid non-zero buffer object if the
buffer object is created successfully. Otherwise, it throws the 'CLError':

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if values specified in flags are not valid.

 * 'CL_INVALID_BUFFER_SIZE' if size is 0 or is greater than
'clDeviceMaxMemAllocSize' value for all devices in context.

 * 'CL_INVALID_HOST_PTR' if host_ptr is NULL and 'CL_MEM_USE_HOST_PTR' or
'CL_MEM_COPY_HOST_PTR' are set in flags or if host_ptr is not NULL but
'CL_MEM_COPY_HOST_PTR' or 'CL_MEM_USE_HOST_PTR' are not set in flags.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for buffer object.

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clCreateBuffer :: Integral a => CLContext -> [CLMemFlag] -> (a, Ptr ()) -> IO CLMem
clCreateBuffer ctx xs (sbuff,buff) = wrapPError $ \perr -> do
  raw_clCreateBuffer ctx flags (fromIntegral sbuff) buff perr
    where
      flags = bitmaskFromFlags xs

-- | Increments the memory object reference count. returns 'True' if the
-- function is executed successfully. After the memobj reference count becomes
-- zero and commands queued for execution on a command-queue(s) that use memobj
-- have finished, the memory object is deleted. It returns 'False' if memobj is
-- not a valid memory object.
clRetainMemObject :: CLMem -> IO Bool
clRetainMemObject mem = wrapCheckSuccess $ raw_clRetainMemObject mem

-- | Decrements the memory object reference count. After the memobj reference
-- count becomes zero and commands queued for execution on a command-queue(s)
-- that use memobj have finished, the memory object is deleted. Returns 'True'
-- if the function is executed successfully. It returns 'False' if memobj is not
-- a valid memory object.
clReleaseMemObject :: CLMem -> IO Bool
clReleaseMemObject mem = wrapCheckSuccess $ raw_clReleaseMemObject mem

-- -----------------------------------------------------------------------------
#c
enum CLChannelOrder {
  cL_R=CL_R,
  cL_A=CL_A,
  cL_INTENSITY=CL_INTENSITY,
  cL_LUMINANCE=CL_LUMINANCE,
  cL_RG=CL_RG,
  cL_RA=CL_RA,
  cL_RGB=CL_RGB,
  cL_RGBA=CL_RGBA,
  cL_ARGB=CL_ARGB,
  cL_BGRA=CL_BGRA,
  };
#endc
{-| Specifies the number of channels and the channel layout i.e. the memory
layout in which channels are stored in the image. Valid values are described in
the table below.

 * 'CL_R', 'CL_A'.

 * 'CL_INTENSITY', This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_UNORM_INT16', 'CL_SNORM_INT8', 'CL_SNORM_INT16',
'CL_HALF_FLOAT', or 'CL_FLOAT'.

 * 'CL_LUMINANCE', This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_UNORM_INT16', 'CL_SNORM_INT8', 'CL_SNORM_INT16',
'CL_HALF_FLOAT', or 'CL_FLOAT'.

 * 'CL_RG', 'CL_RA'.

 * 'CL_RGB', This format can only be used if channel data type =
'CL_UNORM_SHORT_565', 'CL_UNORM_SHORT_555' or 'CL_UNORM_INT101010'.

 * 'CL_RGBA'.

 * 'CL_ARGB', 'CL_BGRA'. This format can only be used if channel data type =
'CL_UNORM_INT8', 'CL_SNORM_INT8', 'CL_SIGNED_INT8' or 'CL_UNSIGNED_INT8'.
-}
{#enum CLChannelOrder {upcaseFirstLetter} #}

#c
enum CLChannelType {
  cL_SNORM_INT8=CL_SNORM_INT8,
  cL_SNORM_INT16=CL_SNORM_INT16,
  cL_UNORM_INT8=CL_UNORM_INT8,
  cL_UNORM_INT16=CL_UNORM_INT16,
  cL_UNORM_SHORT_565=CL_UNORM_SHORT_565,
  cL_UNORM_SHORT_555=CL_UNORM_SHORT_555,
  cL_UNORM_INT_101010=CL_UNORM_INT_101010,
  cL_SIGNED_INT8=CL_SIGNED_INT8,
  cL_SIGNED_INT16=CL_SIGNED_INT16,
  cL_SIGNED_INT32=CL_SIGNED_INT32,
  cL_UNSIGNED_INT8=CL_UNSIGNED_INT8,
  cL_UNSIGNED_INT16=CL_UNSIGNED_INT16,
  cL_UNSIGNED_INT32=CL_UNSIGNED_INT32,
  cL_HALF_FLOAT=CL_HALF_FLOAT,
  cL_FLOAT=CL_FLOAT,
  };
#endc
{-| Describes the size of the channel data type. The number of bits per element
determined by the image_channel_data_type and image_channel_order must be a
power of two. The list of supported values is described in the table below.

 * 'CL_SNORM_INT8', Each channel component is a normalized signed 8-bit integer
value.

 * 'CL_SNORM_INT16', Each channel component is a normalized signed 16-bit
integer value.

 * 'CL_UNORM_INT8', Each channel component is a normalized unsigned 8-bit
integer value.

 * 'CL_UNORM_INT16', Each channel component is a normalized unsigned 16-bit
integer value.

 * 'CL_UNORM_SHORT_565', Represents a normalized 5-6-5 3-channel RGB image. The
channel order must be 'CL_RGB'.

 * 'CL_UNORM_SHORT_555', Represents a normalized x-5-5-5 4-channel xRGB
image. The channel order must be 'CL_RGB'.

 * 'CL_UNORM_INT_101010', Represents a normalized x-10-10-10 4-channel xRGB
image. The channel order must be 'CL_RGB'.

 * 'CL_SIGNED_INT8', Each channel component is an unnormalized signed 8-bit
integer value.

 * 'CL_SIGNED_INT16', Each channel component is an unnormalized signed 16-bit
integer value.

 * 'CL_SIGNED_INT32', Each channel component is an unnormalized signed 32-bit
integer value.

 * 'CL_UNSIGNED_INT8', Each channel component is an unnormalized unsigned 8-bit
integer value.

 * 'CL_UNSIGNED_INT16', Each channel component is an unnormalized unsigned
16-bit integer value.

 * 'CL_UNSIGNED_INT32', Each channel component is an unnormalized unsigned
32-bit integer value.

 * 'CL_HALF_FLOAT', Each channel component is a 16-bit half-float value.

 * 'CL_FLOAT', Each channel component is a single precision floating-point
value.
-}
{#enum CLChannelType {upcaseFirstLetter} #}

data CLImageFormat = CLImageFormat
                     { image_channel_order :: ! CLChannelOrder
                     , image_channel_data_type :: ! CLChannelType }
{#pointer *cl_image_format as CLImageFormat_p -> CLImageFormat#}
instance Storable CLImageFormat where
  alignment _ = alignment (undefined :: CDouble)
  sizeOf _ = {#sizeof cl_image_format #}
  peek p =
    CLImageFormat <$> fmap getEnumCL ({#get cl_image_format.image_channel_order #} p)
           <*> fmap getEnumCL ({#get cl_image_format.image_channel_data_type #} p)
  poke p (CLImageFormat a b) = do
    {#set cl_image_format.image_channel_order #} p (getCLValue a)
    {#set cl_image_format.image_channel_data_type #} p (getCLValue b)

-- -----------------------------------------------------------------------------
{-| Creates a 2D image object.

'clCreateImage2D' returns a valid non-zero image object created if the image
object is created successfully. Otherwise, it throws one of the following
'CLError' exceptions:

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if values specified in flags are not valid.

 * 'CL_INVALID_IMAGE_FORMAT_DESCRIPTOR' if values specified in image_format are
not valid.

 * 'CL_INVALID_IMAGE_SIZE' if image_width or image_height are 0 or if they
exceed values specified in 'CL_DEVICE_IMAGE2D_MAX_WIDTH' or
'CL_DEVICE_IMAGE2D_MAX_HEIGHT' respectively for all devices in context or if
values specified by image_row_pitch do not follow rules described in the
argument description above.

 * 'CL_INVALID_HOST_PTR' if host_ptr is 'nullPtr' and 'CL_MEM_USE_HOST_PTR' or
'CL_MEM_COPY_HOST_PTR' are set in flags or if host_ptr is not 'nullPtr' but
'CL_MEM_COPY_HOST_PTR' or 'CL_MEM_USE_HOST_PTR' are not set in flags.

 * 'CL_IMAGE_FORMAT_NOT_SUPPORTED' if the image_format is not supported.

 * 'CL_MEM_OBJECT_ALLOCATION_FAILURE' if there is a failure to allocate memory
for image object.

 * 'CL_INVALID_OPERATION' if there are no devices in context that support images
(i.e. 'CL_DEVICE_IMAGE_SUPPORT' (specified in the table of OpenCL Device Queries
for 'clGetDeviceInfo') is 'False').

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.

-}

clCreateImage2D :: Integral a => CLContext -- ^ A valid OpenCL context on which
                                           -- the image object is to be created.
                   -> [CLMemFlag] -- ^ A list of flags that is used to specify
                                  -- allocation and usage information about the
                                  -- image memory object being created.
                   -> CLImageFormat -- ^ Structure that describes format
                                    -- properties of the image to be allocated.
                   -> a -- ^ The width of the image in pixels. It must be values
                        -- greater than or equal to 1.
                   -> a -- ^ The height of the image in pixels. It must be
                        -- values greater than or equal to 1.
                   -> a -- ^ The scan-line pitch in bytes. This must be 0 if
                        -- host_ptr is 'nullPtr' and can be either 0 or greater
                        -- than or equal to image_width * size of element in
                        -- bytes if host_ptr is not 'nullPtr'. If host_ptr is
                        -- not 'nullPtr' and image_row_pitch is equal to 0,
                        -- image_row_pitch is calculated as image_width * size
                        -- of element in bytes. If image_row_pitch is not 0, it
                        -- must be a multiple of the image element size in
                        -- bytes.
                   -> Ptr () -- ^ A pointer to the image data that may already
                             -- be allocated by the application. The size of the
                             -- buffer that host_ptr points to must be greater
                             -- than or equal to image_row_pitch *
                             -- image_height. The size of each element in bytes
                             -- must be a power of 2. The image data specified
                             -- by host_ptr is stored as a linear sequence of
                             -- adjacent scanlines. Each scanline is stored as a
                             -- linear sequence of image elements.
                   -> IO CLMem
clCreateImage2D ctx xs fmt iw ih irp ptr = wrapPError $ \perr -> with fmt $ \pfmt -> do
  raw_clCreateImage2D ctx flags pfmt ciw cih cirp ptr perr
    where
      flags = bitmaskFromFlags xs
      ciw = fromIntegral iw
      cih = fromIntegral ih
      cirp = fromIntegral irp

#c
enum CLMemInfo {
  cL_MEM_TYPE=CL_MEM_TYPE,
  cL_MEM_FLAGS=CL_MEM_FLAGS,
  cL_MEM_SIZE=CL_MEM_SIZE,
  cL_MEM_HOST_PTR=CL_MEM_HOST_PTR,
  cL_MEM_MAP_COUNT=CL_MEM_MAP_COUNT,
  cL_MEM_REFERENCE_COUNT=CL_MEM_REFERENCE_COUNT,
  cL_MEM_CONTEXT=CL_MEM_CONTEXT,
  };
#endc
{#enum CLMemInfo {upcaseFirstLetter} #}

-- | Returns the mem object type.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_TYPE'.
clGetMemType :: CLMem -> IO CLMemObjectType
clGetMemType mem =
    wrapGetInfo (\(dat :: Ptr CLMemObjectType_) ->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_MEM_TYPE
      size = fromIntegral $ sizeOf (0::CLMemObjectType_)

-- | Return the flags argument value specified when memobj was created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_FLAGS'.
clGetMemFlags :: CLMem -> IO [CLMemFlag]
clGetMemFlags mem =
    wrapGetInfo (\(dat :: Ptr CLMemFlags_)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) bitmaskToMemFlags
    where
      infoid = getCLValue CL_MEM_FLAGS
      size = fromIntegral $ sizeOf (0::CLMemFlags_)

-- | Return actual size of memobj in bytes.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_SIZE'.
clGetMemSize :: CLMem -> IO CSize
clGetMemSize mem =
    wrapGetInfo (\(dat :: Ptr CSize)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_SIZE
      size = fromIntegral $ sizeOf (0::CSize)

-- | Return the host_ptr argument value specified when memobj is created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_HOST_PTR'.
clGetMemHostPtr :: CLMem -> IO (Ptr ())
clGetMemHostPtr mem =
    wrapGetInfo (\(dat :: Ptr (Ptr ()))->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_HOST_PTR
      size = fromIntegral $ sizeOf (nullPtr::Ptr ())

-- | Map count. The map count returned should be considered immediately
-- stale. It is unsuitable for general use in applications. This feature is
-- provided for debugging.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_MAP_COUNT'.
clGetMemMapCount :: CLMem -> IO CLuint
clGetMemMapCount mem =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_MAP_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return memobj reference count. The reference count returned should be
-- considered immediately stale. It is unsuitable for general use in
-- applications. This feature is provided for identifying memory leaks.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_REFERENCE_COUNT'.
clGetMemReferenceCount :: CLMem -> IO CLuint
clGetMemReferenceCount mem =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return context specified when memory object is created.
--
-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_CONTEXT'.
clGetMemContext :: CLMem -> IO CLContext
clGetMemContext mem =
    wrapGetInfo (\(dat :: Ptr CLContext)->
        raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_MEM_CONTEXT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- -----------------------------------------------------------------------------
{-| Creates a sampler object. A sampler object describes how to sample an image
when the image is read in the kernel. The built-in functions to read from an
image in a kernel take a sampler as an argument. The sampler arguments to the
image read function can be sampler objects created using OpenCL functions and
passed as argument values to the kernel or can be samplers declared inside a
kernel. In this section we discuss how sampler objects are created using OpenCL
functions.

Returns a valid non-zero sampler object if the sampler object is created
successfully. Otherwise, it throws one of the following 'CLError' exceptions:

 * 'CL_INVALID_CONTEXT' if context is not a valid context.

 * 'CL_INVALID_VALUE' if addressing_mode, filter_mode, or normalized_coords or a
combination of these argument values are not valid.

 * 'CL_INVALID_OPERATION' if images are not supported by any device associated
with context (i.e. 'CL_DEVICE_IMAGE_SUPPORT' specified in the table of OpenCL
Device Queries for clGetDeviceInfo is 'False').

 * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required
by the OpenCL implementation on the host.
-}
clCreateSampler :: CLContext -> Bool -> CLAddressingMode -> CLFilterMode
                   -> IO CLSampler
clCreateSampler ctx norm am fm = wrapPError $ \perr -> do
  raw_clCreateSampler ctx (fromBool norm) (getCLValue am) (getCLValue fm) perr

-- | Increments the sampler reference count. 'clCreateSampler' does an implicit
-- retain. Returns 'True' if the function is executed successfully. It returns
-- 'False' if sampler is not a valid sampler object.
clRetainSampler :: CLSampler -> IO Bool
clRetainSampler mem = wrapCheckSuccess $ raw_clRetainSampler mem

-- | Decrements the sampler reference count. The sampler object is deleted after
-- the reference count becomes zero and commands queued for execution on a
-- command-queue(s) that use sampler have finished. 'clReleaseSampler' returns
-- 'True' if the function is executed successfully. It returns 'False' if
-- sampler is not a valid sampler object.
clReleaseSampler :: CLSampler -> IO Bool
clReleaseSampler mem = wrapCheckSuccess $ raw_clReleaseSampler mem

#c
enum CLSamplerInfo {
  cL_SAMPLER_REFERENCE_COUNT=CL_SAMPLER_REFERENCE_COUNT,
  cL_SAMPLER_CONTEXT=CL_SAMPLER_CONTEXT,
  cL_SAMPLER_ADDRESSING_MODE=CL_SAMPLER_ADDRESSING_MODE,
  cL_SAMPLER_FILTER_MODE=CL_SAMPLER_FILTER_MODE,
  cL_SAMPLER_NORMALIZED_COORDS=CL_SAMPLER_NORMALIZED_COORDS
  };
#endc
{#enum CLSamplerInfo {upcaseFirstLetter} #}

-- | Return the sampler reference count. The reference count returned should be
-- considered immediately stale. It is unsuitable for general use in
-- applications. This feature is provided for identifying memory leaks.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_REFERENCE_COUNT'.
clGetSamplerReferenceCount :: CLSampler -> IO CLuint
clGetSamplerReferenceCount sam =
    wrapGetInfo (\(dat :: Ptr CLuint)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_SAMPLER_REFERENCE_COUNT
      size = fromIntegral $ sizeOf (0 :: CLuint)

-- | Return the context specified when the sampler is created.
--
-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_CONTEXT'.
clGetSamplerContext :: CLSampler -> IO CLContext
clGetSamplerContext sam =
    wrapGetInfo (\(dat :: Ptr CLContext)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) id
    where
      infoid = getCLValue CL_SAMPLER_CONTEXT
      size = fromIntegral $ sizeOf (nullPtr :: CLContext)

-- | Return the value specified by addressing_mode argument to clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_ADDRESSING_MODE'.
clGetSamplerAddressingMode :: CLSampler -> IO CLAddressingMode
clGetSamplerAddressingMode sam =
    wrapGetInfo (\(dat :: Ptr CLAddressingMode_)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_SAMPLER_ADDRESSING_MODE
      size = fromIntegral $ sizeOf (0 :: CLAddressingMode_)

-- | Return the value specified by filter_mode argument to clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_FILTER_MODE'.
clGetSamplerFilterMode :: CLSampler -> IO CLFilterMode
clGetSamplerFilterMode sam =
    wrapGetInfo (\(dat :: Ptr CLFilterMode_)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL
    where
      infoid = getCLValue CL_SAMPLER_FILTER_MODE
      size = fromIntegral $ sizeOf (0 :: CLFilterMode_)

-- | Return the value specified by normalized_coords argument to
-- clCreateSampler.
--
-- This function execute OpenCL clGetSamplerInfo with
-- 'CL_SAMPLER_NORMALIZED_COORDS'.
clGetSamplerNormalizedCoords :: CLSampler -> IO Bool
clGetSamplerNormalizedCoords sam =
    wrapGetInfo (\(dat :: Ptr CLbool)->
        raw_clGetSamplerInfo sam infoid size (castPtr dat)) (/=0)
    where
      infoid = getCLValue CL_SAMPLER_NORMALIZED_COORDS
      size = fromIntegral $ sizeOf (0 :: CLbool)

-- -----------------------------------------------------------------------------