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

-- * Exported types
    ArrayImage(..)                          ,
    newZeroArrayImage                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveArrayImageMethod                 ,
#endif

-- ** arrayImageAppend #method:arrayImageAppend#

#if defined(ENABLE_OVERLOADING)
    ArrayImageArrayImageAppendMethodInfo    ,
#endif
    arrayImageArrayImageAppend              ,


-- ** arrayImageGet #method:arrayImageGet#

#if defined(ENABLE_OVERLOADING)
    ArrayImageArrayImageGetMethodInfo       ,
#endif
    arrayImageArrayImageGet                 ,


-- ** empty #method:empty#

    arrayImageEmpty                         ,


-- ** new #method:new#

    arrayImageNew                           ,


-- ** newFromString #method:newFromString#

    arrayImageNewFromString                 ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    arrayImage_area                         ,
#endif
    getArrayImageArea                       ,




    ) 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.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 {-# SOURCE #-} qualified GI.Vips.Enums as Vips.Enums
import {-# SOURCE #-} qualified GI.Vips.Objects.Image as Vips.Image
import {-# SOURCE #-} qualified GI.Vips.Structs.Area as Vips.Area

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

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

foreign import ccall "vips_array_image_get_type" c_vips_array_image_get_type :: 
    IO GType

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

instance B.Types.TypedObject ArrayImage where
    glibType :: IO GType
glibType = IO GType
c_vips_array_image_get_type

instance B.Types.GBoxed ArrayImage

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

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

instance tag ~ 'AttrSet => Constructible ArrayImage tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ArrayImage -> ArrayImage)
-> [AttrOp ArrayImage tag] -> m ArrayImage
new ManagedPtr ArrayImage -> ArrayImage
_ [AttrOp ArrayImage tag]
attrs = do
        ArrayImage
o <- m ArrayImage
forall (m :: * -> *). MonadIO m => m ArrayImage
newZeroArrayImage
        ArrayImage -> [AttrOp ArrayImage 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ArrayImage
o [AttrOp ArrayImage tag]
[AttrOp ArrayImage 'AttrSet]
attrs
        ArrayImage -> m ArrayImage
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayImage
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' arrayImage #area
-- @
getArrayImageArea :: MonadIO m => ArrayImage -> m Vips.Area.Area
getArrayImageArea :: forall (m :: * -> *). MonadIO m => ArrayImage -> m Area
getArrayImageArea ArrayImage
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
$ ArrayImage -> (Ptr ArrayImage -> IO Area) -> IO Area
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ArrayImage
s ((Ptr ArrayImage -> IO Area) -> IO Area)
-> (Ptr ArrayImage -> IO Area) -> IO Area
forall a b. (a -> b) -> a -> b
$ \Ptr ArrayImage
ptr -> do
    let val :: Ptr Area
val = Ptr ArrayImage
ptr Ptr ArrayImage -> 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 ArrayImageAreaFieldInfo
instance AttrInfo ArrayImageAreaFieldInfo where
    type AttrBaseTypeConstraint ArrayImageAreaFieldInfo = (~) ArrayImage
    type AttrAllowedOps ArrayImageAreaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ArrayImageAreaFieldInfo = (~) (Ptr Vips.Area.Area)
    type AttrTransferTypeConstraint ArrayImageAreaFieldInfo = (~)(Ptr Vips.Area.Area)
    type AttrTransferType ArrayImageAreaFieldInfo = (Ptr Vips.Area.Area)
    type AttrGetType ArrayImageAreaFieldInfo = Vips.Area.Area
    type AttrLabel ArrayImageAreaFieldInfo = "area"
    type AttrOrigin ArrayImageAreaFieldInfo = ArrayImage
    attrGet = getArrayImageArea
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

arrayImage_area :: AttrLabelProxy "area"
arrayImage_area = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ArrayImage
type instance O.AttributeList ArrayImage = ArrayImageAttributeList
type ArrayImageAttributeList = ('[ '("area", ArrayImageAreaFieldInfo)] :: [(Symbol, *)])
#endif

-- method ArrayImage::empty
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "ArrayImage" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_array_image_empty" vips_array_image_empty :: 
    IO (Ptr ArrayImage)

-- | Make an empty image array.
-- Handy with @/vips_array_image_add()/@ for bindings
-- which can\'t handle object array arguments.
-- 
-- See also: @/vips_array_image_add()/@.
arrayImageEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ArrayImage
    -- ^ __Returns:__ A new t'GI.Vips.Structs.ArrayImage.ArrayImage'.
arrayImageEmpty :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ArrayImage
arrayImageEmpty  = IO ArrayImage -> m ArrayImage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayImage -> m ArrayImage) -> IO ArrayImage -> m ArrayImage
forall a b. (a -> b) -> a -> b
$ do
    Ptr ArrayImage
result <- IO (Ptr ArrayImage)
vips_array_image_empty
    Text -> Ptr ArrayImage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayImageEmpty" Ptr ArrayImage
result
    ArrayImage
result' <- ((ManagedPtr ArrayImage -> ArrayImage)
-> Ptr ArrayImage -> IO ArrayImage
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayImage -> ArrayImage
ArrayImage) Ptr ArrayImage
result
    ArrayImage -> IO ArrayImage
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayImage
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ArrayImage::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "array"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Vips" , name = "Image" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of #VipsImage"
--                 , 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 images" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of images" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "ArrayImage" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_array_image_new" vips_array_image_new :: 
    Ptr (Ptr Vips.Image.Image) ->           -- array : TCArray False (-1) 1 (TInterface (Name {namespace = "Vips", name = "Image"}))
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr ArrayImage)

-- | Allocate a new array of images and copy /@array@/ into it. Free with
-- 'GI.Vips.Structs.Area.areaUnref'.
-- 
-- The images will all be reffed by this function. They
-- will be automatically unreffed for you by
-- 'GI.Vips.Structs.Area.areaUnref'.
-- 
-- Add an extra NULL element at the end, handy for eg.
-- @/vips_image_pipeline_array()/@ etc.
-- 
-- See also: t'GI.Vips.Structs.Area.Area'.
arrayImageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Vips.Image.Image]
    -- ^ /@array@/: array of t'GI.Vips.Objects.Image.Image'
    -> m ArrayImage
    -- ^ __Returns:__ A new t'GI.Vips.Structs.ArrayImage.ArrayImage'.
arrayImageNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Image] -> m ArrayImage
arrayImageNew [Image]
array = IO ArrayImage -> m ArrayImage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayImage -> m ArrayImage) -> IO ArrayImage -> m ArrayImage
forall a b. (a -> b) -> a -> b
$ do
    let n :: Int32
n = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Image] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Image]
array
    [Ptr Image]
array' <- (Image -> IO (Ptr Image)) -> [Image] -> IO [Ptr Image]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Image -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Image]
array
    Ptr (Ptr Image)
array'' <- [Ptr Image] -> IO (Ptr (Ptr Image))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Image]
array'
    Ptr ArrayImage
result <- Ptr (Ptr Image) -> Int32 -> IO (Ptr ArrayImage)
vips_array_image_new Ptr (Ptr Image)
array'' Int32
n
    Text -> Ptr ArrayImage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayImageNew" Ptr ArrayImage
result
    ArrayImage
result' <- ((ManagedPtr ArrayImage -> ArrayImage)
-> Ptr ArrayImage -> IO ArrayImage
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayImage -> ArrayImage
ArrayImage) Ptr ArrayImage
result
    (Image -> IO ()) -> [Image] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Image -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Image]
array
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
array''
    ArrayImage -> IO ArrayImage
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayImage
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ArrayImage::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Access" }
--           , 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 = "ArrayImage" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_array_image_new_from_string" vips_array_image_new_from_string :: 
    CString ->                              -- string : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Vips", name = "Access"})
    IO (Ptr ArrayImage)

-- | /No description available in the introspection data./
arrayImageNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> Vips.Enums.Access
    -> m ArrayImage
arrayImageNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Access -> m ArrayImage
arrayImageNewFromString Text
string Access
flags = IO ArrayImage -> m ArrayImage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayImage -> m ArrayImage) -> IO ArrayImage -> m ArrayImage
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    let flags' :: CUInt
flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Access -> Int) -> Access -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Access -> Int
forall a. Enum a => a -> Int
fromEnum) Access
flags
    Ptr ArrayImage
result <- CString -> CUInt -> IO (Ptr ArrayImage)
vips_array_image_new_from_string CString
string' CUInt
flags'
    Text -> Ptr ArrayImage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayImageNewFromString" Ptr ArrayImage
result
    ArrayImage
result' <- ((ManagedPtr ArrayImage -> ArrayImage)
-> Ptr ArrayImage -> IO ArrayImage
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayImage -> ArrayImage
ArrayImage) Ptr ArrayImage
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    ArrayImage -> IO ArrayImage
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayImage
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ArrayImage::array_image_append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "ArrayImage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "append to this" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "add this" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "ArrayImage" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_array_image_append" vips_array_image_append :: 
    Ptr ArrayImage ->                       -- array : TInterface (Name {namespace = "Vips", name = "ArrayImage"})
    Ptr Vips.Image.Image ->                 -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO (Ptr ArrayImage)

-- | Make a new t'GI.Vips.Structs.ArrayImage.ArrayImage', one larger than /@array@/, with /@image@/ appended
-- to the end.
-- Handy with 'GI.Vips.Structs.ArrayImage.arrayImageEmpty' for bindings
-- which can\'t handle object array arguments.
-- 
-- See also: 'GI.Vips.Structs.ArrayImage.arrayImageEmpty'.
arrayImageArrayImageAppend ::
    (B.CallStack.HasCallStack, MonadIO m, Vips.Image.IsImage a) =>
    ArrayImage
    -- ^ /@array@/: append to this
    -> a
    -- ^ /@image@/: add this
    -> m ArrayImage
    -- ^ __Returns:__ A new t'GI.Vips.Structs.ArrayImage.ArrayImage'.
arrayImageArrayImageAppend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
ArrayImage -> a -> m ArrayImage
arrayImageArrayImageAppend ArrayImage
array a
image = IO ArrayImage -> m ArrayImage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayImage -> m ArrayImage) -> IO ArrayImage -> m ArrayImage
forall a b. (a -> b) -> a -> b
$ do
    Ptr ArrayImage
array' <- ArrayImage -> IO (Ptr ArrayImage)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ArrayImage
array
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr ArrayImage
result <- Ptr ArrayImage -> Ptr Image -> IO (Ptr ArrayImage)
vips_array_image_append Ptr ArrayImage
array' Ptr Image
image'
    Text -> Ptr ArrayImage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayImageArrayImageAppend" Ptr ArrayImage
result
    ArrayImage
result' <- ((ManagedPtr ArrayImage -> ArrayImage)
-> Ptr ArrayImage -> IO ArrayImage
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayImage -> ArrayImage
ArrayImage) Ptr ArrayImage
result
    ArrayImage -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ArrayImage
array
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    ArrayImage -> IO ArrayImage
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayImage
result'

#if defined(ENABLE_OVERLOADING)
data ArrayImageArrayImageAppendMethodInfo
instance (signature ~ (a -> m ArrayImage), MonadIO m, Vips.Image.IsImage a) => O.OverloadedMethod ArrayImageArrayImageAppendMethodInfo ArrayImage signature where
    overloadedMethod = arrayImageArrayImageAppend

instance O.OverloadedMethodInfo ArrayImageArrayImageAppendMethodInfo ArrayImage where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Structs.ArrayImage.arrayImageArrayImageAppend",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Structs-ArrayImage.html#v:arrayImageArrayImageAppend"
        }


#endif

-- method ArrayImage::array_image_get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "ArrayImage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #VipsArrayImage to fetch from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of array" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of array" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TCArray
--                  False
--                  (-1)
--                  1
--                  (TInterface Name { namespace = "Vips" , name = "Image" }))
-- throws : False
-- Skip return : False

foreign import ccall "vips_array_image_get" vips_array_image_get :: 
    Ptr ArrayImage ->                       -- array : TInterface (Name {namespace = "Vips", name = "ArrayImage"})
    Ptr Int32 ->                            -- n : TBasicType TInt
    IO (Ptr (Ptr Vips.Image.Image))

-- | Fetch an image array from a t'GI.Vips.Structs.ArrayImage.ArrayImage'. Useful for language bindings.
arrayImageArrayImageGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ArrayImage
    -- ^ /@array@/: the t'GI.Vips.Structs.ArrayImage.ArrayImage' to fetch from
    -> m [Vips.Image.Image]
    -- ^ __Returns:__ array of t'GI.Vips.Objects.Image.Image'
arrayImageArrayImageGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ArrayImage -> m [Image]
arrayImageArrayImageGet ArrayImage
array = IO [Image] -> m [Image]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Image] -> m [Image]) -> IO [Image] -> m [Image]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ArrayImage
array' <- ArrayImage -> IO (Ptr ArrayImage)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ArrayImage
array
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr (Ptr Image)
result <- Ptr ArrayImage -> Ptr Int32 -> IO (Ptr (Ptr Image))
vips_array_image_get Ptr ArrayImage
array' Ptr Int32
n
    Int32
n' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Text -> Ptr (Ptr Image) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayImageArrayImageGet" Ptr (Ptr Image)
result
    [Ptr Image]
result' <- (Int32 -> Ptr (Ptr Image) -> IO [Ptr Image]
forall a b. Integral a => a -> Ptr (Ptr b) -> IO [Ptr b]
unpackPtrArrayWithLength Int32
n') Ptr (Ptr Image)
result
    [Image]
result'' <- (Ptr Image -> IO Image) -> [Ptr Image] -> IO [Image]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Image -> Image
Vips.Image.Image) [Ptr Image]
result'
    ArrayImage -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ArrayImage
array
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    [Image] -> IO [Image]
forall (m :: * -> *) a. Monad m => a -> m a
return [Image]
result''

#if defined(ENABLE_OVERLOADING)
data ArrayImageArrayImageGetMethodInfo
instance (signature ~ (m [Vips.Image.Image]), MonadIO m) => O.OverloadedMethod ArrayImageArrayImageGetMethodInfo ArrayImage signature where
    overloadedMethod = arrayImageArrayImageGet

instance O.OverloadedMethodInfo ArrayImageArrayImageGetMethodInfo ArrayImage where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Structs.ArrayImage.arrayImageArrayImageGet",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Structs-ArrayImage.html#v:arrayImageArrayImageGet"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveArrayImageMethod (t :: Symbol) (o :: *) :: * where
    ResolveArrayImageMethod "arrayImageAppend" o = ArrayImageArrayImageAppendMethodInfo
    ResolveArrayImageMethod "arrayImageGet" o = ArrayImageArrayImageGetMethodInfo
    ResolveArrayImageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif