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


{-# LINE 1 "lib/CPython/Types/Capsule.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
--
-- This program 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 General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module CPython.Types.Capsule
	( Capsule
	, capsuleType
	--, new
	, getPointer
	--, getDestructor
	, getContext
	, getName
	, importNamed
	, isValid
	, setPointer
	--, setDestructor
	, setContext
	--, setName
	) where


import           Data.Text (Text)

import           CPython.Internal hiding (new)

-- type Destructor = Ptr () -> IO ()
newtype Capsule = Capsule (ForeignPtr Capsule)

instance Object Capsule where
	toObject (Capsule x) = SomeObject x
	fromForeignPtr = Capsule

instance Concrete Capsule where
	concreteType _ = capsuleType

capsuleType :: Type
capsuleType =
  unsafePerformIO $
  let {res = capsuleType'_} in
  peekStaticObject res >>= \res' ->
  return (res')
{-# LINE 51 "lib/CPython/Types/Capsule.chs" #-}

-- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule
-- new = undefined

-- | Retrieve the pointer stored in the capsule. On failure, throws an
-- exception.
--
-- The name parameter must compare exactly to the name stored in the capsule.
-- If the name stored in the capsule is 'Nothing', the name passed in must
-- also be 'Nothing'. Python uses the C function strcmp() to compare capsule
-- names.
getPointer :: Capsule -> Maybe Text -> IO (Ptr ())
getPointer py name =
	withObject py $ \pyPtr ->
	maybeWith withText name $ \namePtr ->
	pyCapsuleGetPointer pyPtr namePtr

-- getDestructor :: Capsule -> IO (Maybe Destructor)
-- getDestructor = undefined

-- | Return the current context stored in the capsule, which might be @NULL@.
getContext :: Capsule -> IO (Ptr ())
getContext py =
	withObject py $ \pyPtr -> do
	pyErrClear
{-# LINE 76 "lib/CPython/Types/Capsule.chs" #-}
	ptr <- pyCapsuleGetContext pyPtr
	if ptr /= nullPtr
		then return ptr
		else do
			exc <- pyErrOccurred
{-# LINE 81 "lib/CPython/Types/Capsule.chs" #-}
			exceptionIf $ exc /= nullPtr
			return ptr

-- | Return the current name stored in the capsule, which might be 'Nothing'.
getName :: Capsule -> IO (Maybe Text)
getName py =
	withObject py $ \pyPtr -> do
	pyErrClear
{-# LINE 89 "lib/CPython/Types/Capsule.chs" #-}
	ptr <- pyCapsuleGetName pyPtr
	if ptr /= nullPtr
		then Just `fmap` peekText ptr
		else do
			exc <- pyErrOccurred
{-# LINE 94 "lib/CPython/Types/Capsule.chs" #-}
			exceptionIf $ exc /= nullPtr
			return Nothing

-- | Import a pointer to a C object from a capsule attribute in a module.
-- The name parameter should specify the full name to the attribute, as in
-- @\"module.attribute\"@. The name stored in the capsule must match this
-- string exactly. If the second parameter is 'False', import the module
-- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise,
-- imports the module conventionally (using @PyImport_ImportModule()@).
--
-- Return the capsule&#x2019;s internal pointer on success. On failure, throw
-- an exception. If the module could not be imported, and if importing in
-- non-blocking mode, returns 'Nothing'.
importNamed :: Text -> Bool -> IO (Maybe (Ptr ()))
importNamed name block =
	withText name $ \namePtr ->
	let noBlock = cFromBool (not block) in do
	pyErrClear
{-# LINE 112 "lib/CPython/Types/Capsule.chs" #-}
	ptr <- pyCapsuleImport namePtr noBlock
	if ptr /= nullPtr
		then return $ Just ptr
		else do
			exc <- pyErrOccurred
{-# LINE 117 "lib/CPython/Types/Capsule.chs" #-}
			exceptionIf $ exc /= nullPtr
			return Nothing

-- | Determines whether or not a capsule is valid. A valid capsule's type is
-- 'capsuleType', has a non-NULL pointer stored in it, and its internal name
-- matches the name parameter. (See 'getPointer' for information on how
-- capsule names are compared.)
--
-- In other words, if 'isValid' returns 'True', calls to any of the
-- accessors (any function starting with @get@) are guaranteed to succeed.
isValid :: Capsule -> Maybe Text -> IO Bool
isValid py name =
	withObject py $ \pyPtr ->
	maybeWith withText name $ \namePtr ->
	pyCapsuleIsValid pyPtr namePtr
	>>= checkBoolReturn

-- | Set the void pointer inside the capsule. The pointer may not be @NULL@.
setPointer :: Capsule -> Ptr () -> IO (())
setPointer a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = id a2} in 
  setPointer'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 139 "lib/CPython/Types/Capsule.chs" #-}

-- setDestructor :: Capsule -> Maybe Destructor -> IO ()
-- setDestructor = undefined

-- | Set the context pointer inside the capsule.
setContext :: Capsule -> Ptr () -> IO (())
setContext a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = id a2} in 
  setContext'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 148 "lib/CPython/Types/Capsule.chs" #-}

-- setName :: Capsule -> Maybe Text -> IO ()
-- setName = undefined

foreign import ccall unsafe "CPython/Types/Capsule.chs.h hscpython_PyCapsule_Type"
  capsuleType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_GetPointer"
  pyCapsuleGetPointer :: ((Ptr ()) -> ((Ptr CChar) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyErr_Clear"
  pyErrClear :: (IO ())

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_GetContext"
  pyCapsuleGetContext :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyErr_Occurred"
  pyErrOccurred :: (IO (Ptr ()))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_GetName"
  pyCapsuleGetName :: ((Ptr ()) -> (IO (Ptr CChar)))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_Import"
  pyCapsuleImport :: ((Ptr CChar) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_IsValid"
  pyCapsuleIsValid :: ((Ptr ()) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_SetPointer"
  setPointer'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_SetContext"
  setContext'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))