{-# LINE 1 "lib/CPython/Types/Capsule.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module CPython.Types.Capsule
( Capsule
, capsuleType
, getPointer
, getContext
, getName
, importNamed
, isValid
, setPointer
, setContext
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
import Data.Text (Text)
import CPython.Internal hiding (new)
newtype Capsule = Capsule (ForeignPtr Capsule)
instance Object Capsule where
toObject :: Capsule -> SomeObject
toObject (Capsule x :: ForeignPtr Capsule
x) = ForeignPtr Capsule -> SomeObject
forall a. Object a => ForeignPtr a -> SomeObject
SomeObject ForeignPtr Capsule
x
fromForeignPtr :: ForeignPtr Capsule -> Capsule
fromForeignPtr = ForeignPtr Capsule -> Capsule
Capsule
instance Concrete Capsule where
concreteType :: Capsule -> Type
concreteType _ = Type
capsuleType
capsuleType :: (Type)
capsuleType :: Type
capsuleType =
IO Type -> Type
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Type -> Type) -> IO Type -> Type
forall a b. (a -> b) -> a -> b
$
IO (Ptr ())
capsuleType'_ IO (Ptr ()) -> (Ptr () -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
Ptr () -> IO Type
forall obj a. Object obj => Ptr a -> IO obj
peekStaticObject Ptr ()
res IO Type -> (Type -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Type
res' ->
Type -> IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
res')
{-# LINE 51 "lib/CPython/Types/Capsule.chs" #-}
getPointer :: Capsule -> Maybe Text -> IO (Ptr ())
getPointer :: Capsule -> Maybe Text -> IO (Ptr ())
getPointer py :: Capsule
py name :: Maybe Text
name =
Capsule -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
py ((Ptr () -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr ->
(Text -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ()))
-> Maybe Text -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Text -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a. Text -> (Ptr CChar -> IO a) -> IO a
withText Maybe Text
name ((Ptr CChar -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \namePtr :: Ptr CChar
namePtr ->
Ptr () -> Ptr CChar -> IO (Ptr ())
pyCapsuleGetPointer Ptr ()
pyPtr Ptr CChar
namePtr
getContext :: Capsule -> IO (Ptr ())
getContext :: Capsule -> IO (Ptr ())
getContext py :: Capsule
py =
Capsule -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
py ((Ptr () -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr -> do
IO ()
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
getName :: Capsule -> IO (Maybe Text)
getName :: Capsule -> IO (Maybe Text)
getName py :: Capsule
py =
Capsule -> (Ptr () -> IO (Maybe Text)) -> IO (Maybe Text)
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
py ((Ptr () -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr () -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr -> do
IO ()
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
importNamed :: Text -> Bool -> IO (Maybe (Ptr ()))
importNamed :: Text -> Bool -> IO (Maybe (Ptr ()))
importNamed name :: Text
name block :: Bool
block =
Text -> (Ptr CChar -> IO (Maybe (Ptr ()))) -> IO (Maybe (Ptr ()))
forall a. Text -> (Ptr CChar -> IO a) -> IO a
withText Text
name ((Ptr CChar -> IO (Maybe (Ptr ()))) -> IO (Maybe (Ptr ())))
-> (Ptr CChar -> IO (Maybe (Ptr ()))) -> IO (Maybe (Ptr ()))
forall a b. (a -> b) -> a -> b
$ \namePtr :: Ptr CChar
namePtr ->
let noBlock :: CInt
noBlock = Bool -> CInt
cFromBool (Bool -> Bool
not Bool
block) in do
IO ()
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
isValid :: Capsule -> Maybe Text -> IO Bool
isValid :: Capsule -> Maybe Text -> IO Bool
isValid py :: Capsule
py name :: Maybe Text
name =
Capsule -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
py ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr ->
(Text -> (Ptr CChar -> IO Bool) -> IO Bool)
-> Maybe Text -> (Ptr CChar -> IO Bool) -> IO Bool
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Text -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. Text -> (Ptr CChar -> IO a) -> IO a
withText Maybe Text
name ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \namePtr :: Ptr CChar
namePtr ->
Ptr () -> Ptr CChar -> IO CInt
pyCapsuleIsValid Ptr ()
pyPtr Ptr CChar
namePtr
IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO Bool
checkBoolReturn
setPointer :: (Capsule) -> (Ptr ()) -> IO ((()))
setPointer :: Capsule -> Ptr () -> IO ()
setPointer a1 :: Capsule
a1 a2 :: Ptr ()
a2 =
Capsule -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' ->
let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in
Ptr () -> Ptr () -> IO CInt
setPointer'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')
{-# LINE 139 "lib/CPython/Types/Capsule.chs" #-}
setContext :: (Capsule) -> (Ptr ()) -> IO ((()))
setContext :: Capsule -> Ptr () -> IO ()
setContext a1 :: Capsule
a1 a2 :: Ptr ()
a2 =
Capsule -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Capsule
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' ->
let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in
Ptr () -> Ptr () -> IO CInt
setContext'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')
{-# LINE 148 "lib/CPython/Types/Capsule.chs" #-}
foreign import ccall unsafe "CPython/Types/Capsule.chs.h hscpython_PyCapsule_Type"
capsuleType'_ :: (IO (C2HSImp.Ptr ()))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_GetPointer"
pyCapsuleGetPointer :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.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 :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyErr_Occurred"
pyErrOccurred :: (IO (C2HSImp.Ptr ()))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_GetName"
pyCapsuleGetName :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_Import"
pyCapsuleImport :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_IsValid"
pyCapsuleIsValid :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_SetPointer"
setPointer'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))
foreign import ccall safe "CPython/Types/Capsule.chs.h PyCapsule_SetContext"
setContext'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))