{-# 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.Area
    ( 

-- * Exported types
    Area(..)                                ,
    newZeroArea                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAreaMethod                       ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    AreaCopyMethodInfo                      ,
#endif
    areaCopy                                ,


-- ** freeCb #method:freeCb#

    areaFreeCb                              ,


-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    AreaGetDataMethodInfo                   ,
#endif
    areaGetData                             ,


-- ** new #method:new#

    areaNew                                 ,


-- ** newArray #method:newArray#

    areaNewArray                            ,


-- ** newArrayObject #method:newArrayObject#

    areaNewArrayObject                      ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    AreaUnrefMethodInfo                     ,
#endif
    areaUnref                               ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    area_data                               ,
#endif
    clearAreaData                           ,
    getAreaData                             ,
    setAreaData                             ,


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

#if defined(ENABLE_OVERLOADING)
    area_length                             ,
#endif
    getAreaLength                           ,
    setAreaLength                           ,


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

#if defined(ENABLE_OVERLOADING)
    area_n                                  ,
#endif
    getAreaN                                ,
    setAreaN                                ,




    ) 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.GHashTable as B.GHT
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

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

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

foreign import ccall "vips_area_get_type" c_vips_area_get_type :: 
    IO GType

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

instance B.Types.TypedObject Area where
    glibType :: IO GType
glibType = IO GType
c_vips_area_get_type

instance B.Types.GBoxed Area

-- | Convert 'Area' 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 Area) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vips_area_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Area -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Area
P.Nothing = Ptr GValue -> Ptr Area -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Area
forall a. Ptr a
FP.nullPtr :: FP.Ptr Area)
    gvalueSet_ Ptr GValue
gv (P.Just Area
obj) = Area -> (Ptr Area -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Area
obj (Ptr GValue -> Ptr Area -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Area)
gvalueGet_ Ptr GValue
gv = do
        Ptr Area
ptr <- Ptr GValue -> IO (Ptr Area)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Area)
        if Ptr Area
ptr Ptr Area -> Ptr Area -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Area
forall a. Ptr a
FP.nullPtr
        then Area -> Maybe Area
forall a. a -> Maybe a
P.Just (Area -> Maybe Area) -> IO Area -> IO (Maybe Area)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Area -> Area
Area Ptr Area
ptr
        else Maybe Area -> IO (Maybe Area)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Area
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Area` struct initialized to zero.
newZeroArea :: MonadIO m => m Area
newZeroArea :: forall (m :: * -> *). MonadIO m => m Area
newZeroArea = IO Area -> m Area
forall a. IO a -> m a
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
$ Int -> IO (Ptr Area)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr Area) -> (Ptr Area -> IO Area) -> IO Area
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Area -> Area
Area

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


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

-- | Set the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' area [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setAreaData :: MonadIO m => Area -> Ptr () -> m ()
setAreaData :: forall (m :: * -> *). MonadIO m => Area -> Ptr () -> m ()
setAreaData Area
s Ptr ()
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Area -> (Ptr Area -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Area
s ((Ptr Area -> IO ()) -> IO ()) -> (Ptr Area -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Area
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Area
ptr Ptr Area -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr ()
val :: Ptr ())

-- | Set the value of the “@data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #data
-- @
clearAreaData :: MonadIO m => Area -> m ()
clearAreaData :: forall (m :: * -> *). MonadIO m => Area -> m ()
clearAreaData Area
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Area -> (Ptr Area -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Area
s ((Ptr Area -> IO ()) -> IO ()) -> (Ptr Area -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Area
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Area
ptr Ptr Area -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING)
data AreaDataFieldInfo
instance AttrInfo AreaDataFieldInfo where
    type AttrBaseTypeConstraint AreaDataFieldInfo = (~) Area
    type AttrAllowedOps AreaDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AreaDataFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint AreaDataFieldInfo = (~)(Ptr ())
    type AttrTransferType AreaDataFieldInfo = (Ptr ())
    type AttrGetType AreaDataFieldInfo = Ptr ()
    type AttrLabel AreaDataFieldInfo = "data"
    type AttrOrigin AreaDataFieldInfo = Area
    attrGet = getAreaData
    attrSet = setAreaData
    attrConstruct = undefined
    attrClear = clearAreaData
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Area.data"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Structs-Area.html#g:attr:data"
        })

area_data :: AttrLabelProxy "data"
area_data = AttrLabelProxy

#endif


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

-- | Set the value of the “@length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' area [ #length 'Data.GI.Base.Attributes.:=' value ]
-- @
setAreaLength :: MonadIO m => Area -> Word64 -> m ()
setAreaLength :: forall (m :: * -> *). MonadIO m => Area -> Word64 -> m ()
setAreaLength Area
s Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Area -> (Ptr Area -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Area
s ((Ptr Area -> IO ()) -> IO ()) -> (Ptr Area -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Area
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Area
ptr Ptr Area -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data AreaLengthFieldInfo
instance AttrInfo AreaLengthFieldInfo where
    type AttrBaseTypeConstraint AreaLengthFieldInfo = (~) Area
    type AttrAllowedOps AreaLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AreaLengthFieldInfo = (~) Word64
    type AttrTransferTypeConstraint AreaLengthFieldInfo = (~)Word64
    type AttrTransferType AreaLengthFieldInfo = Word64
    type AttrGetType AreaLengthFieldInfo = Word64
    type AttrLabel AreaLengthFieldInfo = "length"
    type AttrOrigin AreaLengthFieldInfo = Area
    attrGet = getAreaLength
    attrSet = setAreaLength
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Area.length"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Structs-Area.html#g:attr:length"
        })

area_length :: AttrLabelProxy "length"
area_length = AttrLabelProxy

#endif


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

-- | Set the value of the “@n@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' area [ #n 'Data.GI.Base.Attributes.:=' value ]
-- @
setAreaN :: MonadIO m => Area -> Int32 -> m ()
setAreaN :: forall (m :: * -> *). MonadIO m => Area -> Int32 -> m ()
setAreaN Area
s Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Area -> (Ptr Area -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Area
s ((Ptr Area -> IO ()) -> IO ()) -> (Ptr Area -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Area
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Area
ptr Ptr Area -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data AreaNFieldInfo
instance AttrInfo AreaNFieldInfo where
    type AttrBaseTypeConstraint AreaNFieldInfo = (~) Area
    type AttrAllowedOps AreaNFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AreaNFieldInfo = (~) Int32
    type AttrTransferTypeConstraint AreaNFieldInfo = (~)Int32
    type AttrTransferType AreaNFieldInfo = Int32
    type AttrGetType AreaNFieldInfo = Int32
    type AttrLabel AreaNFieldInfo = "n"
    type AttrOrigin AreaNFieldInfo = Area
    attrGet = getAreaN
    attrSet = setAreaN
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Area.n"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Structs-Area.html#g:attr:n"
        })

area_n :: AttrLabelProxy "n"
area_n = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Area
type instance O.AttributeList Area = AreaAttributeList
type AreaAttributeList = ('[ '("data", AreaDataFieldInfo), '("length", AreaLengthFieldInfo), '("n", AreaNFieldInfo)] :: [(Symbol, *)])
#endif

-- method Area::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "free_fn"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "CallbackFn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , 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 = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data will be freed with this function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Area" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_new" vips_area_new :: 
    FunPtr Vips.Callbacks.C_CallbackFn ->   -- free_fn : TInterface (Name {namespace = "Vips", name = "CallbackFn"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO (Ptr Area)

-- | A VipsArea wraps a chunk of memory. It adds reference counting and a free
-- function. It also keeps a count and a @/GType/@, so the area can be an array.
-- 
-- This type is used for things like passing an array of double or an array of
-- t'GI.Vips.Objects.Object.Object' pointers to operations, and for reference-counted immutable
-- strings.
-- 
-- Inital count == 1, so @/_unref()/@ after attaching somewhere.
-- 
-- See also: 'GI.Vips.Structs.Area.areaUnref'.
areaNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vips.Callbacks.CallbackFn
    -- ^ /@freeFn@/: /@data@/ will be freed with this function
    -> m Area
    -- ^ __Returns:__ the new t'GI.Vips.Structs.Area.Area'.
areaNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CallbackFn -> m Area
areaNew CallbackFn
freeFn = IO Area -> m Area
forall a. IO a -> m a
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
$ 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
freeFn' <- 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
freeFn)
    Ptr (FunPtr CallbackFn) -> FunPtr CallbackFn -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr CallbackFn)
ptrfreeFn FunPtr CallbackFn
freeFn'
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr Area
result <- FunPtr CallbackFn -> Ptr () -> IO (Ptr Area)
vips_area_new FunPtr CallbackFn
freeFn' Ptr ()
forall a. Ptr a
data_
    Text -> Ptr Area -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"areaNew" Ptr Area
result
    Area
result' <- ((ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Area -> Area
Area) Ptr Area
result
    Area -> IO Area
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Area
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Area::new_array
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%GType of elements to store"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sizeof_type"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "sizeof() an element in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of elements in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Area" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_new_array" vips_area_new_array :: 
    CGType ->                               -- type : TBasicType TGType
    Word64 ->                               -- sizeof_type : TBasicType TUInt64
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr Area)

-- | An area which holds an array of elements of some @/GType/@. To set values for
-- the elements, get the pointer and write.
-- 
-- See also: 'GI.Vips.Structs.Area.areaUnref'.
areaNewArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: @/GType/@ of elements to store
    -> Word64
    -- ^ /@sizeofType@/: @/sizeof()/@ an element in the array
    -> Int32
    -- ^ /@n@/: number of elements in the array
    -> m Area
    -- ^ __Returns:__ the new t'GI.Vips.Structs.Area.Area'.
areaNewArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Word64 -> Int32 -> m Area
areaNewArray GType
type_ Word64
sizeofType Int32
n = IO Area -> m Area
forall a. IO a -> m a
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
$ do
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    Ptr Area
result <- Word64 -> Word64 -> Int32 -> IO (Ptr Area)
vips_area_new_array Word64
type_' Word64
sizeofType Int32
n
    Text -> Ptr Area -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"areaNewArray" Ptr Area
result
    Area
result' <- ((ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Area -> Area
Area) Ptr Area
result
    Area -> IO Area
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Area
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Area::new_array_object
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of elements in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Area" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_new_array_object" vips_area_new_array_object :: 
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr Area)

-- | An area which holds an array of @/GObject/@ s. See 'GI.Vips.Structs.Area.areaNewArray'. When
-- the area is freed, each @/GObject/@ will be unreffed.
-- 
-- Add an extra NULL element at the end, handy for eg.
-- @/vips_image_pipeline_array()/@ etc.
-- 
-- See also: 'GI.Vips.Structs.Area.areaUnref'.
areaNewArrayObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@n@/: number of elements in the array
    -> m Area
    -- ^ __Returns:__ the new t'GI.Vips.Structs.Area.Area'.
areaNewArrayObject :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m Area
areaNewArrayObject Int32
n = IO Area -> m Area
forall a. IO a -> m a
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
$ do
    Ptr Area
result <- Int32 -> IO (Ptr Area)
vips_area_new_array_object Int32
n
    Text -> Ptr Area -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"areaNewArrayObject" Ptr Area
result
    Area
result' <- ((ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Area -> Area
Area) Ptr Area
result
    Area -> IO Area
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Area
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Area::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "area"
--           , argType = TInterface Name { namespace = "Vips" , name = "Area" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Area" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_copy" vips_area_copy :: 
    Ptr Area ->                             -- area : TInterface (Name {namespace = "Vips", name = "Area"})
    IO (Ptr Area)

-- | /No description available in the introspection data./
areaCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Area
    -> m Area
areaCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Area -> m Area
areaCopy Area
area = IO Area -> m Area
forall a. IO a -> m a
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
$ do
    Ptr Area
area' <- Area -> IO (Ptr Area)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Area
area
    Ptr Area
result <- Ptr Area -> IO (Ptr Area)
vips_area_copy Ptr Area
area'
    Text -> Ptr Area -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"areaCopy" Ptr Area
result
    Area
result' <- ((ManagedPtr Area -> Area) -> Ptr Area -> IO Area
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Area -> Area
Area) Ptr Area
result
    Area -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Area
area
    Area -> IO Area
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Area
result'

#if defined(ENABLE_OVERLOADING)
data AreaCopyMethodInfo
instance (signature ~ (m Area), MonadIO m) => O.OverloadedMethod AreaCopyMethodInfo Area signature where
    overloadedMethod = areaCopy

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


#endif

-- method Area::get_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "area"
--           , argType = TInterface Name { namespace = "Vips" , name = "Area" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsArea 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 "optionally return length in bytes here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optionally return number of elements here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optionally return element type here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "sizeof_type"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optionally return sizeof() element type here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_get_data" vips_area_get_data :: 
    Ptr Area ->                             -- area : TInterface (Name {namespace = "Vips", name = "Area"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr Int32 ->                            -- n : TBasicType TInt
    Ptr CGType ->                           -- type : TBasicType TGType
    Ptr Word64 ->                           -- sizeof_type : TBasicType TUInt64
    IO (Ptr ())

-- | Return the data pointer plus optionally the length in bytes of an area,
-- the number of elements, the @/GType/@ of each element and the @/sizeof()/@ each
-- element.
areaGetData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Area
    -- ^ /@area@/: t'GI.Vips.Structs.Area.Area' to fetch from
    -> m ((Ptr (), Word64, Int32, GType, Word64))
    -- ^ __Returns:__ The pointer held by /@area@/.
areaGetData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Area -> m (Ptr (), Word64, Int32, GType, Word64)
areaGetData Area
area = IO (Ptr (), Word64, Int32, GType, Word64)
-> m (Ptr (), Word64, Int32, GType, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr (), Word64, Int32, GType, Word64)
 -> m (Ptr (), Word64, Int32, GType, Word64))
-> IO (Ptr (), Word64, Int32, GType, Word64)
-> m (Ptr (), Word64, Int32, GType, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Area
area' <- Area -> IO (Ptr Area)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Area
area
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Word64
type_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CGType)
    Ptr Word64
sizeofType <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr ()
result <- Ptr Area
-> Ptr Word64
-> Ptr Int32
-> Ptr Word64
-> Ptr Word64
-> IO (Ptr ())
vips_area_get_data Ptr Area
area' Ptr Word64
length_ Ptr Int32
n Ptr Word64
type_ Ptr Word64
sizeofType
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Int32
n' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Word64
type_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
type_
    let type_'' :: GType
type_'' = Word64 -> GType
GType Word64
type_'
    Word64
sizeofType' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
sizeofType
    Area -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Area
area
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
type_
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
sizeofType
    (Ptr (), Word64, Int32, GType, Word64)
-> IO (Ptr (), Word64, Int32, GType, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
result, Word64
length_', Int32
n', GType
type_'', Word64
sizeofType')

#if defined(ENABLE_OVERLOADING)
data AreaGetDataMethodInfo
instance (signature ~ (m ((Ptr (), Word64, Int32, GType, Word64))), MonadIO m) => O.OverloadedMethod AreaGetDataMethodInfo Area signature where
    overloadedMethod = areaGetData

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


#endif

-- method Area::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "area"
--           , argType = TInterface Name { namespace = "Vips" , name = "Area" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_unref" vips_area_unref :: 
    Ptr Area ->                             -- area : TInterface (Name {namespace = "Vips", name = "Area"})
    IO ()

-- | /No description available in the introspection data./
areaUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Area
    -> m ()
areaUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Area -> m ()
areaUnref Area
area = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Area
area' <- Area -> IO (Ptr Area)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Area
area
    Ptr Area -> IO ()
vips_area_unref Ptr Area
area'
    Area -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Area
area
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AreaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AreaUnrefMethodInfo Area signature where
    overloadedMethod = areaUnref

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


#endif

-- method Area::free_cb
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "mem"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "area"
--           , argType = TInterface Name { namespace = "Vips" , name = "Area" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_area_free_cb" vips_area_free_cb :: 
    Ptr () ->                               -- mem : TBasicType TPtr
    Ptr Area ->                             -- area : TInterface (Name {namespace = "Vips", name = "Area"})
    IO Int32

-- | /No description available in the introspection data./
areaFreeCb ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -> Area
    -> m Int32
areaFreeCb :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> Area -> m Int32
areaFreeCb Ptr ()
mem Area
area = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Area
area' <- Area -> IO (Ptr Area)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Area
area
    Int32
result <- Ptr () -> Ptr Area -> IO Int32
vips_area_free_cb Ptr ()
mem Ptr Area
area'
    Area -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Area
area
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAreaMethod (t :: Symbol) (o :: *) :: * where
    ResolveAreaMethod "copy" o = AreaCopyMethodInfo
    ResolveAreaMethod "unref" o = AreaUnrefMethodInfo
    ResolveAreaMethod "getData" o = AreaGetDataMethodInfo
    ResolveAreaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAreaMethod t Area, O.OverloadedMethod info Area p) => OL.IsLabel t (Area -> 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 ~ ResolveAreaMethod t Area, O.OverloadedMethod info Area p, R.HasField t Area p) => R.HasField t Area p where
    getField = O.overloadedMethod @info

#endif

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

#endif