{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Vips.Structs.Blob
    ( 

-- * Exported types
    Blob(..)                                ,
    newZeroBlob                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [get]("GI.Vips.Structs.Blob#g:method:get").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBlobMethod                       ,
#endif

-- ** copy #method:copy#

    blobCopy                                ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    BlobGetMethodInfo                       ,
#endif
    blobGet                                 ,


-- ** new #method:new#

    blobNew                                 ,




 -- * Properties


-- ** area #attr:area#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    blob_area                               ,
#endif
    getBlobArea                             ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Vips.Callbacks as Vips.Callbacks
import {-# SOURCE #-} qualified GI.Vips.Structs.Area as Vips.Area

-- | Memory-managed wrapper type.
newtype Blob = Blob (SP.ManagedPtr Blob)
    deriving (Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c== :: Blob -> Blob -> Bool
Eq)

instance SP.ManagedPtrNewtype Blob where
    toManagedPtr :: Blob -> ManagedPtr Blob
toManagedPtr (Blob ManagedPtr Blob
p) = ManagedPtr Blob
p

foreign import ccall "vips_blob_get_type" c_vips_blob_get_type :: 
    IO GType

type instance O.ParentTypes Blob = '[]
instance O.HasParentTypes Blob

instance B.Types.TypedObject Blob where
    glibType :: IO GType
glibType = IO GType
c_vips_blob_get_type

instance B.Types.GBoxed Blob

-- | Convert 'Blob' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Blob) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vips_blob_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Blob -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Blob
P.Nothing = Ptr GValue -> Ptr Blob -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Blob
forall a. Ptr a
FP.nullPtr :: FP.Ptr Blob)
    gvalueSet_ Ptr GValue
gv (P.Just Blob
obj) = Blob -> (Ptr Blob -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Blob
obj (Ptr GValue -> Ptr Blob -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Blob)
gvalueGet_ Ptr GValue
gv = do
        Ptr Blob
ptr <- Ptr GValue -> IO (Ptr Blob)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Blob)
        if Ptr Blob
ptr Ptr Blob -> Ptr Blob -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Blob
forall a. Ptr a
FP.nullPtr
        then Blob -> Maybe Blob
forall a. a -> Maybe a
P.Just (Blob -> Maybe Blob) -> IO Blob -> IO (Maybe Blob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Blob -> Blob) -> Ptr Blob -> IO Blob
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Blob -> Blob
Blob Ptr Blob
ptr
        else Maybe Blob -> IO (Maybe Blob)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Blob
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Blob` struct initialized to zero.
newZeroBlob :: MonadIO m => m Blob
newZeroBlob :: forall (m :: * -> *). MonadIO m => m Blob
newZeroBlob = IO Blob -> m Blob
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Blob -> m Blob) -> IO Blob -> m Blob
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Blob)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr Blob) -> (Ptr Blob -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Blob -> Blob) -> Ptr Blob -> IO Blob
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Blob -> Blob
Blob

instance tag ~ 'AttrSet => Constructible Blob tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Blob -> Blob) -> [AttrOp Blob tag] -> m Blob
new ManagedPtr Blob -> Blob
_ [AttrOp Blob tag]
attrs = do
        Blob
o <- m Blob
forall (m :: * -> *). MonadIO m => m Blob
newZeroBlob
        Blob -> [AttrOp Blob 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Blob
o [AttrOp Blob tag]
[AttrOp Blob 'AttrSet]
attrs
        Blob -> m Blob
forall (m :: * -> *) a. Monad m => a -> m a
return Blob
o


-- | Get the value of the “@area@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' blob #area
-- @
getBlobArea :: MonadIO m => Blob -> m Vips.Area.Area
getBlobArea :: forall (m :: * -> *). MonadIO m => Blob -> m Area
getBlobArea Blob
s = IO Area -> m Area
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Area -> m Area) -> IO Area -> m Area
forall a b. (a -> b) -> a -> b
$ Blob -> (Ptr Blob -> IO Area) -> IO Area
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Blob
s ((Ptr Blob -> IO Area) -> IO Area)
-> (Ptr Blob -> IO Area) -> IO Area
forall a b. (a -> b) -> a -> b
$ \Ptr Blob
ptr -> do
    let val :: Ptr Area
val = Ptr Blob
ptr Ptr Blob -> Int -> Ptr Area
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Vips.Area.Area)
    Area
val' <- ((ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Area -> Area
Vips.Area.Area) Ptr Area
val
    Area -> IO Area
forall (m :: * -> *) a. Monad m => a -> m a
return Area
val'

#if defined(ENABLE_OVERLOADING)
data BlobAreaFieldInfo
instance AttrInfo BlobAreaFieldInfo where
    type AttrBaseTypeConstraint BlobAreaFieldInfo = (~) Blob
    type AttrAllowedOps BlobAreaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint BlobAreaFieldInfo = (~) (Ptr Vips.Area.Area)
    type AttrTransferTypeConstraint BlobAreaFieldInfo = (~)(Ptr Vips.Area.Area)
    type AttrTransferType BlobAreaFieldInfo = (Ptr Vips.Area.Area)
    type AttrGetType BlobAreaFieldInfo = Vips.Area.Area
    type AttrLabel BlobAreaFieldInfo = "area"
    type AttrOrigin BlobAreaFieldInfo = Blob
    attrGet = getBlobArea
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Blob.area"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Blob.html#g:attr:area"
        })

blob_area :: AttrLabelProxy "area"
blob_area = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Blob
type instance O.AttributeList Blob = BlobAttributeList
type BlobAttributeList = ('[ '("area", BlobAreaFieldInfo)] :: [(Symbol, *)])
#endif

-- method Blob::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "free_fn"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "CallbackFn" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "@data will be freed with this function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to store" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes in @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of bytes in @data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Blob" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_blob_new" vips_blob_new :: 
    FunPtr Vips.Callbacks.C_CallbackFn ->   -- free_fn : TInterface (Name {namespace = "Vips", name = "CallbackFn"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO (Ptr Blob)

-- | Like 'GI.Vips.Structs.Area.areaNew', but track a length as well. The returned t'GI.Vips.Structs.Blob.Blob'
-- takes ownership of /@data@/ and will free it with /@freeFn@/. Pass NULL for
-- /@freeFn@/ to not transfer ownership.
-- 
-- An area of mem with a free func and a length (some sort of binary object,
-- like an ICC profile).
-- 
-- See also: 'GI.Vips.Structs.Area.areaUnref'.
blobNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (Vips.Callbacks.CallbackFn)
    -- ^ /@freeFn@/: /@data@/ will be freed with this function
    -> ByteString
    -- ^ /@data@/: data to store
    -> m Blob
    -- ^ __Returns:__ the new t'GI.Vips.Structs.Blob.Blob'.
blobNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe CallbackFn -> ByteString -> m Blob
blobNew Maybe CallbackFn
freeFn ByteString
data_ = IO Blob -> m Blob
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Blob -> m Blob) -> IO Blob -> m Blob
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    FunPtr CallbackFn
maybeFreeFn <- case Maybe CallbackFn
freeFn of
        Maybe CallbackFn
Nothing -> FunPtr CallbackFn -> IO (FunPtr CallbackFn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr CallbackFn
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just CallbackFn
jFreeFn -> do
            Ptr (FunPtr CallbackFn)
ptrfreeFn <- IO (Ptr (FunPtr CallbackFn))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Vips.Callbacks.C_CallbackFn))
            FunPtr CallbackFn
jFreeFn' <- CallbackFn -> IO (FunPtr CallbackFn)
Vips.Callbacks.mk_CallbackFn (Maybe (Ptr (FunPtr CallbackFn)) -> CallbackFn -> CallbackFn
Vips.Callbacks.wrap_CallbackFn (Ptr (FunPtr CallbackFn) -> Maybe (Ptr (FunPtr CallbackFn))
forall a. a -> Maybe a
Just Ptr (FunPtr CallbackFn)
ptrfreeFn) CallbackFn
jFreeFn)
            Ptr (FunPtr CallbackFn) -> FunPtr CallbackFn -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr CallbackFn)
ptrfreeFn FunPtr CallbackFn
jFreeFn'
            FunPtr CallbackFn -> IO (FunPtr CallbackFn)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr CallbackFn
jFreeFn'
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Blob
result <- FunPtr CallbackFn -> Ptr Word8 -> Word64 -> IO (Ptr Blob)
vips_blob_new FunPtr CallbackFn
maybeFreeFn Ptr Word8
data_' Word64
length_
    Text -> Ptr Blob -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blobNew" Ptr Blob
result
    Blob
result' <- ((ManagedPtr Blob -> Blob) -> Ptr Blob -> IO Blob
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Blob -> Blob
Blob) Ptr Blob
result
    Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return Blob
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Blob::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blob"
--           , argType = TInterface Name { namespace = "Vips" , name = "Blob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsBlob to fetch from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return number of bytes of data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return number of bytes of data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "vips_blob_get" vips_blob_get :: 
    Ptr Blob ->                             -- blob : TInterface (Name {namespace = "Vips", name = "Blob"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)

-- | Get the data from a t'GI.Vips.Structs.Blob.Blob'.
-- 
-- See also: 'GI.Vips.Structs.Blob.blobNew'.
blobGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Blob
    -- ^ /@blob@/: t'GI.Vips.Structs.Blob.Blob' to fetch from
    -> m ByteString
    -- ^ __Returns:__ the
    -- data
blobGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Blob -> m ByteString
blobGet Blob
blob = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blob
blob' <- Blob -> IO (Ptr Blob)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Blob
blob
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr Blob -> Ptr Word64 -> IO (Ptr Word8)
vips_blob_get Ptr Blob
blob' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr Word8 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blobGet" Ptr Word8
result
    ByteString
result' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
result
    Blob -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Blob
blob
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
data BlobGetMethodInfo
instance (signature ~ (m ByteString), MonadIO m) => O.OverloadedMethod BlobGetMethodInfo Blob signature where
    overloadedMethod = blobGet

instance O.OverloadedMethodInfo BlobGetMethodInfo Blob where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Blob.blobGet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Blob.html#v:blobGet"
        })


#endif

-- method Blob::copy
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to store" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes in @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of bytes in @data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Blob" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_blob_copy" vips_blob_copy :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO (Ptr Blob)

-- | Like 'GI.Vips.Structs.Blob.blobNew', but take a copy of the data. Useful for bindings
-- which strugle with callbacks.
-- 
-- See also: 'GI.Vips.Structs.Blob.blobNew'.
blobCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: data to store
    -> m Blob
    -- ^ __Returns:__ the new t'GI.Vips.Structs.Blob.Blob'.
blobCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Blob
blobCopy ByteString
data_ = IO Blob -> m Blob
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Blob -> m Blob) -> IO Blob -> m Blob
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Blob
result <- Ptr Word8 -> Word64 -> IO (Ptr Blob)
vips_blob_copy Ptr Word8
data_' Word64
length_
    Text -> Ptr Blob -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blobCopy" Ptr Blob
result
    Blob
result' <- ((ManagedPtr Blob -> Blob) -> Ptr Blob -> IO Blob
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Blob -> Blob
Blob) Ptr Blob
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return Blob
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBlobMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlobMethod "get" o = BlobGetMethodInfo
    ResolveBlobMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBlobMethod t Blob, O.OverloadedMethod info Blob p) => OL.IsLabel t (Blob -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBlobMethod t Blob, O.OverloadedMethod info Blob p, R.HasField t Blob p) => R.HasField t Blob p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveBlobMethod t Blob, O.OverloadedMethodInfo info Blob) => OL.IsLabel t (O.MethodProxy info Blob) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif