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

-- * Exported types
    ArrayDouble(..)                         ,
    newZeroArrayDouble                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveArrayDoubleMethod                ,
#endif

-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    ArrayDoubleGetMethodInfo                ,
#endif
    arrayDoubleGet                          ,


-- ** new #method:new#

    arrayDoubleNew                          ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    arrayDouble_area                        ,
#endif
    getArrayDoubleArea                      ,




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

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

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

foreign import ccall "vips_array_double_get_type" c_vips_array_double_get_type :: 
    IO GType

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

instance B.Types.TypedObject ArrayDouble where
    glibType :: IO GType
glibType = IO GType
c_vips_array_double_get_type

instance B.Types.GBoxed ArrayDouble

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

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

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

arrayDouble_area :: AttrLabelProxy "area"
arrayDouble_area = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ArrayDouble
type instance O.AttributeList ArrayDouble = ArrayDoubleAttributeList
type ArrayDoubleAttributeList = ('[ '("area", ArrayDoubleAreaFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "vips_array_double_new" vips_array_double_new :: 
    Ptr CDouble ->                          -- array : TCArray False (-1) 1 (TBasicType TDouble)
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr ArrayDouble)

-- | Allocate a new array of doubles and copy /@array@/ into it. Free with
-- 'GI.Vips.Structs.Area.areaUnref'.
-- 
-- See also: t'GI.Vips.Structs.Area.Area'.
arrayDoubleNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Double]
    -- ^ /@array@/: array of double
    -> m ArrayDouble
    -- ^ __Returns:__ A new t'GI.Vips.Structs.ArrayDouble.ArrayDouble'.
arrayDoubleNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Double] -> m ArrayDouble
arrayDoubleNew [Double]
array = IO ArrayDouble -> m ArrayDouble
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayDouble -> m ArrayDouble)
-> IO ArrayDouble -> m ArrayDouble
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
$ [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Double]
array
    Ptr CDouble
array' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
array
    Ptr ArrayDouble
result <- Ptr CDouble -> Int32 -> IO (Ptr ArrayDouble)
vips_array_double_new Ptr CDouble
array' Int32
n
    Text -> Ptr ArrayDouble -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayDoubleNew" Ptr ArrayDouble
result
    ArrayDouble
result' <- ((ManagedPtr ArrayDouble -> ArrayDouble)
-> Ptr ArrayDouble -> IO ArrayDouble
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ArrayDouble -> ArrayDouble
ArrayDouble) Ptr ArrayDouble
result
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
array'
    ArrayDouble -> IO ArrayDouble
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayDouble
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Fetch a double array from a t'GI.Vips.Structs.ArrayDouble.ArrayDouble'. Useful for language bindings.
arrayDoubleGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ArrayDouble
    -- ^ /@array@/: the t'GI.Vips.Structs.ArrayDouble.ArrayDouble' to fetch from
    -> m [Double]
    -- ^ __Returns:__ array of double
arrayDoubleGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ArrayDouble -> m [Double]
arrayDoubleGet ArrayDouble
array = IO [Double] -> m [Double]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Double] -> m [Double]) -> IO [Double] -> m [Double]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ArrayDouble
array' <- ArrayDouble -> IO (Ptr ArrayDouble)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ArrayDouble
array
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr CDouble
result <- Ptr ArrayDouble -> Ptr Int32 -> IO (Ptr CDouble)
vips_array_double_get Ptr ArrayDouble
array' Ptr Int32
n
    Int32
n' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Text -> Ptr CDouble -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayDoubleGet" Ptr CDouble
result
    [Double]
result' <- ((CDouble -> Double) -> Int32 -> Ptr CDouble -> IO [Double]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
n') Ptr CDouble
result
    ArrayDouble -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ArrayDouble
array
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    [Double] -> IO [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return [Double]
result'

#if defined(ENABLE_OVERLOADING)
data ArrayDoubleGetMethodInfo
instance (signature ~ (m [Double]), MonadIO m) => O.OverloadedMethod ArrayDoubleGetMethodInfo ArrayDouble signature where
    overloadedMethod = arrayDoubleGet

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


#endif

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

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

#endif

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

#endif