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

-- * Exported types
    ArrayInt(..)                            ,
    newZeroArrayInt                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveArrayIntMethod                   ,
#endif

-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    ArrayIntGetMethodInfo                   ,
#endif
    arrayIntGet                             ,


-- ** new #method:new#

    arrayIntNew                             ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    arrayInt_area                           ,
#endif
    getArrayIntArea                         ,




    ) 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.Kind as DK
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.Structs.Area as Vips.Area

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

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

foreign import ccall "vips_array_int_get_type" c_vips_array_int_get_type :: 
    IO GType

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

instance B.Types.TypedObject ArrayInt where
    glibType :: IO GType
glibType = IO GType
c_vips_array_int_get_type

instance B.Types.GBoxed ArrayInt

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

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

instance tag ~ 'AttrSet => Constructible ArrayInt tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ArrayInt -> ArrayInt)
-> [AttrOp ArrayInt tag] -> m ArrayInt
new ManagedPtr ArrayInt -> ArrayInt
_ [AttrOp ArrayInt tag]
attrs = do
        ArrayInt
o <- m ArrayInt
forall (m :: * -> *). MonadIO m => m ArrayInt
newZeroArrayInt
        ArrayInt -> [AttrOp ArrayInt 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ArrayInt
o [AttrOp ArrayInt tag]
[AttrOp ArrayInt 'AttrSet]
attrs
        ArrayInt -> m ArrayInt
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayInt
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' arrayInt #area
-- @
getArrayIntArea :: MonadIO m => ArrayInt -> m Vips.Area.Area
getArrayIntArea :: forall (m :: * -> *). MonadIO m => ArrayInt -> m Area
getArrayIntArea ArrayInt
s = 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
$ ArrayInt -> (Ptr ArrayInt -> IO Area) -> IO Area
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ArrayInt
s ((Ptr ArrayInt -> IO Area) -> IO Area)
-> (Ptr ArrayInt -> IO Area) -> IO Area
forall a b. (a -> b) -> a -> b
$ \Ptr ArrayInt
ptr -> do
    let val :: Ptr Area
val = Ptr ArrayInt
ptr Ptr ArrayInt -> 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Area
val'

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

arrayInt_area :: AttrLabelProxy "area"
arrayInt_area = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ArrayInt
type instance O.AttributeList ArrayInt = ArrayIntAttributeList
type ArrayIntAttributeList = ('[ '("area", ArrayIntAreaFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "vips_array_int_new" vips_array_int_new :: 
    Ptr Int32 ->                            -- array : TCArray False (-1) 1 (TBasicType TInt)
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr ArrayInt)

-- | Allocate a new array of ints and copy /@array@/ into it. Free with
-- 'GI.Vips.Structs.Area.areaUnref'.
-- 
-- See also: t'GI.Vips.Structs.Area.Area'.
arrayIntNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Int32]
    -- ^ /@array@/: array of int
    -> m ArrayInt
    -- ^ __Returns:__ A new t'GI.Vips.Structs.ArrayInt.ArrayInt'.
arrayIntNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Int32] -> m ArrayInt
arrayIntNew [Int32]
array = IO ArrayInt -> m ArrayInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayInt -> m ArrayInt) -> IO ArrayInt -> m ArrayInt
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
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
array
    Ptr Int32
array' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
array
    Ptr ArrayInt
result <- Ptr Int32 -> Int32 -> IO (Ptr ArrayInt)
vips_array_int_new Ptr Int32
array' Int32
n
    Text -> Ptr ArrayInt -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayIntNew" Ptr ArrayInt
result
    ArrayInt
result' <- ((ManagedPtr ArrayInt -> ArrayInt) -> Ptr ArrayInt -> IO ArrayInt
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayInt -> ArrayInt
ArrayInt) Ptr ArrayInt
result
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
array'
    ArrayInt -> IO ArrayInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayInt
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ArrayInt::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "ArrayInt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #VipsArrayInt 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 (TBasicType TInt))
-- throws : False
-- Skip return : False

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

-- | Fetch an int array from a t'GI.Vips.Structs.ArrayInt.ArrayInt'. Useful for language bindings.
arrayIntGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ArrayInt
    -- ^ /@array@/: the t'GI.Vips.Structs.ArrayInt.ArrayInt' to fetch from
    -> m [Int32]
    -- ^ __Returns:__ array of int
arrayIntGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ArrayInt -> m [Int32]
arrayIntGet ArrayInt
array = 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 ArrayInt
array' <- ArrayInt -> IO (Ptr ArrayInt)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ArrayInt
array
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
result <- Ptr ArrayInt -> Ptr Int32 -> IO (Ptr Int32)
vips_array_int_get Ptr ArrayInt
array' Ptr Int32
n
    Int32
n' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Text -> Ptr Int32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayIntGet" Ptr Int32
result
    [Int32]
result' <- (Int32 -> Ptr Int32 -> IO [Int32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Int32
n') Ptr Int32
result
    ArrayInt -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ArrayInt
array
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    [Int32] -> IO [Int32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
result'

#if defined(ENABLE_OVERLOADING)
data ArrayIntGetMethodInfo
instance (signature ~ (m [Int32]), MonadIO m) => O.OverloadedMethod ArrayIntGetMethodInfo ArrayInt signature where
    overloadedMethod = arrayIntGet

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveArrayIntMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveArrayIntMethod "get" o = ArrayIntGetMethodInfo
    ResolveArrayIntMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif