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

-- * Exported types
    ForeignLoad(..)                         ,
    IsForeignLoad                           ,
    toForeignLoad                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [argumentIsset]("GI.Vips.Objects.Object#g:method:argumentIsset"), [argumentNeedsstring]("GI.Vips.Objects.Object#g:method:argumentNeedsstring"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [build]("GI.Vips.Objects.Object#g:method:build"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidate]("GI.Vips.Objects.Operation#g:method:invalidate"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [localCb]("GI.Vips.Objects.Object#g:method:localCb"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [preclose]("GI.Vips.Objects.Object#g:method:preclose"), [printDump]("GI.Vips.Objects.Object#g:method:printDump"), [printName]("GI.Vips.Objects.Object#g:method:printName"), [printSummary]("GI.Vips.Objects.Object#g:method:printSummary"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [rewind]("GI.Vips.Objects.Object#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sanity]("GI.Vips.Objects.Object#g:method:sanity"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unrefOutputs]("GI.Vips.Objects.Object#g:method:unrefOutputs"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getArgumentFlags]("GI.Vips.Objects.Object#g:method:getArgumentFlags"), [getArgumentPriority]("GI.Vips.Objects.Object#g:method:getArgumentPriority"), [getArgumentToString]("GI.Vips.Objects.Object#g:method:getArgumentToString"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Vips.Objects.Object#g:method:getDescription"), [getFlags]("GI.Vips.Objects.Operation#g:method:getFlags"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setArgumentFromString]("GI.Vips.Objects.Object#g:method:setArgumentFromString"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFromString]("GI.Vips.Objects.Object#g:method:setFromString"), [setRequired]("GI.Vips.Objects.Object#g:method:setRequired"), [setStatic]("GI.Vips.Objects.Object#g:method:setStatic").

#if defined(ENABLE_OVERLOADING)
    ResolveForeignLoadMethod                ,
#endif



 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadAccessPropertyInfo           ,
#endif
    constructForeignLoadAccess              ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadAccess                       ,
#endif
    getForeignLoadAccess                    ,
    setForeignLoadAccess                    ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadDiscPropertyInfo             ,
#endif
    constructForeignLoadDisc                ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadDisc                         ,
#endif
    getForeignLoadDisc                      ,
    setForeignLoadDisc                      ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadFailPropertyInfo             ,
#endif
    constructForeignLoadFail                ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadFail                         ,
#endif
    getForeignLoadFail                      ,
    setForeignLoadFail                      ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadFlagsPropertyInfo            ,
#endif
    constructForeignLoadFlags               ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadFlags                        ,
#endif
    getForeignLoadFlags                     ,
    setForeignLoadFlags                     ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadMemoryPropertyInfo           ,
#endif
    constructForeignLoadMemory              ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadMemory                       ,
#endif
    getForeignLoadMemory                    ,
    setForeignLoadMemory                    ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadOutPropertyInfo              ,
#endif
    clearForeignLoadOut                     ,
    constructForeignLoadOut                 ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadOut                          ,
#endif
    getForeignLoadOut                       ,
    setForeignLoadOut                       ,


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

#if defined(ENABLE_OVERLOADING)
    ForeignLoadSequentialPropertyInfo       ,
#endif
    constructForeignLoadSequential          ,
#if defined(ENABLE_OVERLOADING)
    foreignLoadSequential                   ,
#endif
    getForeignLoadSequential                ,
    setForeignLoadSequential                ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Vips.Enums as Vips.Enums
import {-# SOURCE #-} qualified GI.Vips.Flags as Vips.Flags
import {-# SOURCE #-} qualified GI.Vips.Objects.Foreign as Vips.Foreign
import {-# SOURCE #-} qualified GI.Vips.Objects.Image as Vips.Image
import {-# SOURCE #-} qualified GI.Vips.Objects.Object as Vips.Object
import {-# SOURCE #-} qualified GI.Vips.Objects.Operation as Vips.Operation

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

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

foreign import ccall "vips_foreign_load_get_type"
    c_vips_foreign_load_get_type :: IO B.Types.GType

instance B.Types.TypedObject ForeignLoad where
    glibType :: IO GType
glibType = IO GType
c_vips_foreign_load_get_type

instance B.Types.GObject ForeignLoad

-- | Type class for types which can be safely cast to `ForeignLoad`, for instance with `toForeignLoad`.
class (SP.GObject o, O.IsDescendantOf ForeignLoad o) => IsForeignLoad o
instance (SP.GObject o, O.IsDescendantOf ForeignLoad o) => IsForeignLoad o

instance O.HasParentTypes ForeignLoad
type instance O.ParentTypes ForeignLoad = '[Vips.Foreign.Foreign, Vips.Operation.Operation, Vips.Object.Object, GObject.Object.Object]

-- | Cast to `ForeignLoad`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toForeignLoad :: (MIO.MonadIO m, IsForeignLoad o) => o -> m ForeignLoad
toForeignLoad :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> m ForeignLoad
toForeignLoad = IO ForeignLoad -> m ForeignLoad
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ForeignLoad -> m ForeignLoad)
-> (o -> IO ForeignLoad) -> o -> m ForeignLoad
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ForeignLoad -> ForeignLoad) -> o -> IO ForeignLoad
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ForeignLoad -> ForeignLoad
ForeignLoad

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

#if defined(ENABLE_OVERLOADING)
type family ResolveForeignLoadMethod (t :: Symbol) (o :: *) :: * where
    ResolveForeignLoadMethod "argumentIsset" o = Vips.Object.ObjectArgumentIssetMethodInfo
    ResolveForeignLoadMethod "argumentNeedsstring" o = Vips.Object.ObjectArgumentNeedsstringMethodInfo
    ResolveForeignLoadMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveForeignLoadMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveForeignLoadMethod "build" o = Vips.Object.ObjectBuildMethodInfo
    ResolveForeignLoadMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveForeignLoadMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveForeignLoadMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveForeignLoadMethod "invalidate" o = Vips.Operation.OperationInvalidateMethodInfo
    ResolveForeignLoadMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveForeignLoadMethod "localCb" o = Vips.Object.ObjectLocalCbMethodInfo
    ResolveForeignLoadMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveForeignLoadMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveForeignLoadMethod "preclose" o = Vips.Object.ObjectPrecloseMethodInfo
    ResolveForeignLoadMethod "printDump" o = Vips.Object.ObjectPrintDumpMethodInfo
    ResolveForeignLoadMethod "printName" o = Vips.Object.ObjectPrintNameMethodInfo
    ResolveForeignLoadMethod "printSummary" o = Vips.Object.ObjectPrintSummaryMethodInfo
    ResolveForeignLoadMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveForeignLoadMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveForeignLoadMethod "rewind" o = Vips.Object.ObjectRewindMethodInfo
    ResolveForeignLoadMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveForeignLoadMethod "sanity" o = Vips.Object.ObjectSanityMethodInfo
    ResolveForeignLoadMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveForeignLoadMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveForeignLoadMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveForeignLoadMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveForeignLoadMethod "unrefOutputs" o = Vips.Object.ObjectUnrefOutputsMethodInfo
    ResolveForeignLoadMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveForeignLoadMethod "getArgumentFlags" o = Vips.Object.ObjectGetArgumentFlagsMethodInfo
    ResolveForeignLoadMethod "getArgumentPriority" o = Vips.Object.ObjectGetArgumentPriorityMethodInfo
    ResolveForeignLoadMethod "getArgumentToString" o = Vips.Object.ObjectGetArgumentToStringMethodInfo
    ResolveForeignLoadMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveForeignLoadMethod "getDescription" o = Vips.Object.ObjectGetDescriptionMethodInfo
    ResolveForeignLoadMethod "getFlags" o = Vips.Operation.OperationGetFlagsMethodInfo
    ResolveForeignLoadMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveForeignLoadMethod "setArgumentFromString" o = Vips.Object.ObjectSetArgumentFromStringMethodInfo
    ResolveForeignLoadMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveForeignLoadMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveForeignLoadMethod "setFromString" o = Vips.Object.ObjectSetFromStringMethodInfo
    ResolveForeignLoadMethod "setRequired" o = Vips.Object.ObjectSetRequiredMethodInfo
    ResolveForeignLoadMethod "setStatic" o = Vips.Object.ObjectSetStaticMethodInfo
    ResolveForeignLoadMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "access"
   -- Type: TInterface (Name {namespace = "Vips", name = "Access"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@access@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #access
-- @
getForeignLoadAccess :: (MonadIO m, IsForeignLoad o) => o -> m Vips.Enums.Access
getForeignLoadAccess :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> m Access
getForeignLoadAccess o
obj = IO Access -> m Access
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Access -> m Access) -> IO Access -> m Access
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Access
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"access"

-- | Set the value of the “@access@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #access 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadAccess :: (MonadIO m, IsForeignLoad o) => o -> Vips.Enums.Access -> m ()
setForeignLoadAccess :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> Access -> m ()
setForeignLoadAccess o
obj Access
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Access -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"access" Access
val

-- | Construct a `GValueConstruct` with valid value for the “@access@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadAccess :: (IsForeignLoad o, MIO.MonadIO m) => Vips.Enums.Access -> m (GValueConstruct o)
constructForeignLoadAccess :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
Access -> m (GValueConstruct o)
constructForeignLoadAccess Access
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Access -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"access" Access
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadAccessPropertyInfo
instance AttrInfo ForeignLoadAccessPropertyInfo where
    type AttrAllowedOps ForeignLoadAccessPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadAccessPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadAccessPropertyInfo = (~) Vips.Enums.Access
    type AttrTransferTypeConstraint ForeignLoadAccessPropertyInfo = (~) Vips.Enums.Access
    type AttrTransferType ForeignLoadAccessPropertyInfo = Vips.Enums.Access
    type AttrGetType ForeignLoadAccessPropertyInfo = Vips.Enums.Access
    type AttrLabel ForeignLoadAccessPropertyInfo = "access"
    type AttrOrigin ForeignLoadAccessPropertyInfo = ForeignLoad
    attrGet = getForeignLoadAccess
    attrSet = setForeignLoadAccess
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadAccess
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.access"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:access"
        })
#endif

-- VVV Prop "disc"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@disc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #disc
-- @
getForeignLoadDisc :: (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadDisc :: forall (m :: * -> *) o. (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadDisc o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"disc"

-- | Set the value of the “@disc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #disc 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadDisc :: (MonadIO m, IsForeignLoad o) => o -> Bool -> m ()
setForeignLoadDisc :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> Bool -> m ()
setForeignLoadDisc o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"disc" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@disc@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadDisc :: (IsForeignLoad o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructForeignLoadDisc :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructForeignLoadDisc Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"disc" Bool
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadDiscPropertyInfo
instance AttrInfo ForeignLoadDiscPropertyInfo where
    type AttrAllowedOps ForeignLoadDiscPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadDiscPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadDiscPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ForeignLoadDiscPropertyInfo = (~) Bool
    type AttrTransferType ForeignLoadDiscPropertyInfo = Bool
    type AttrGetType ForeignLoadDiscPropertyInfo = Bool
    type AttrLabel ForeignLoadDiscPropertyInfo = "disc"
    type AttrOrigin ForeignLoadDiscPropertyInfo = ForeignLoad
    attrGet = getForeignLoadDisc
    attrSet = setForeignLoadDisc
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadDisc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.disc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:disc"
        })
#endif

-- VVV Prop "fail"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@fail@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #fail
-- @
getForeignLoadFail :: (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadFail :: forall (m :: * -> *) o. (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadFail o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"fail"

-- | Set the value of the “@fail@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #fail 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadFail :: (MonadIO m, IsForeignLoad o) => o -> Bool -> m ()
setForeignLoadFail :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> Bool -> m ()
setForeignLoadFail o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"fail" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@fail@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadFail :: (IsForeignLoad o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructForeignLoadFail :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructForeignLoadFail Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"fail" Bool
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadFailPropertyInfo
instance AttrInfo ForeignLoadFailPropertyInfo where
    type AttrAllowedOps ForeignLoadFailPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadFailPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadFailPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ForeignLoadFailPropertyInfo = (~) Bool
    type AttrTransferType ForeignLoadFailPropertyInfo = Bool
    type AttrGetType ForeignLoadFailPropertyInfo = Bool
    type AttrLabel ForeignLoadFailPropertyInfo = "fail"
    type AttrOrigin ForeignLoadFailPropertyInfo = ForeignLoad
    attrGet = getForeignLoadFail
    attrSet = setForeignLoadFail
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadFail
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.fail"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:fail"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Vips", name = "ForeignFlags"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #flags
-- @
getForeignLoadFlags :: (MonadIO m, IsForeignLoad o) => o -> m [Vips.Flags.ForeignFlags]
getForeignLoadFlags :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> m [ForeignFlags]
getForeignLoadFlags o
obj = IO [ForeignFlags] -> m [ForeignFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [ForeignFlags] -> m [ForeignFlags])
-> IO [ForeignFlags] -> m [ForeignFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [ForeignFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Set the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadFlags :: (MonadIO m, IsForeignLoad o) => o -> [Vips.Flags.ForeignFlags] -> m ()
setForeignLoadFlags :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> [ForeignFlags] -> m ()
setForeignLoadFlags o
obj [ForeignFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [ForeignFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [ForeignFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadFlags :: (IsForeignLoad o, MIO.MonadIO m) => [Vips.Flags.ForeignFlags] -> m (GValueConstruct o)
constructForeignLoadFlags :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
[ForeignFlags] -> m (GValueConstruct o)
constructForeignLoadFlags [ForeignFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [ForeignFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [ForeignFlags]
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadFlagsPropertyInfo
instance AttrInfo ForeignLoadFlagsPropertyInfo where
    type AttrAllowedOps ForeignLoadFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadFlagsPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadFlagsPropertyInfo = (~) [Vips.Flags.ForeignFlags]
    type AttrTransferTypeConstraint ForeignLoadFlagsPropertyInfo = (~) [Vips.Flags.ForeignFlags]
    type AttrTransferType ForeignLoadFlagsPropertyInfo = [Vips.Flags.ForeignFlags]
    type AttrGetType ForeignLoadFlagsPropertyInfo = [Vips.Flags.ForeignFlags]
    type AttrLabel ForeignLoadFlagsPropertyInfo = "flags"
    type AttrOrigin ForeignLoadFlagsPropertyInfo = ForeignLoad
    attrGet = getForeignLoadFlags
    attrSet = setForeignLoadFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:flags"
        })
#endif

-- VVV Prop "memory"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@memory@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #memory
-- @
getForeignLoadMemory :: (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadMemory :: forall (m :: * -> *) o. (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadMemory o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"memory"

-- | Set the value of the “@memory@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #memory 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadMemory :: (MonadIO m, IsForeignLoad o) => o -> Bool -> m ()
setForeignLoadMemory :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> Bool -> m ()
setForeignLoadMemory o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"memory" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@memory@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadMemory :: (IsForeignLoad o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructForeignLoadMemory :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructForeignLoadMemory Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"memory" Bool
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadMemoryPropertyInfo
instance AttrInfo ForeignLoadMemoryPropertyInfo where
    type AttrAllowedOps ForeignLoadMemoryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadMemoryPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadMemoryPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ForeignLoadMemoryPropertyInfo = (~) Bool
    type AttrTransferType ForeignLoadMemoryPropertyInfo = Bool
    type AttrGetType ForeignLoadMemoryPropertyInfo = Bool
    type AttrLabel ForeignLoadMemoryPropertyInfo = "memory"
    type AttrOrigin ForeignLoadMemoryPropertyInfo = ForeignLoad
    attrGet = getForeignLoadMemory
    attrSet = setForeignLoadMemory
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadMemory
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.memory"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:memory"
        })
#endif

-- VVV Prop "out"
   -- Type: TInterface (Name {namespace = "Vips", name = "Image"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@out@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #out
-- @
getForeignLoadOut :: (MonadIO m, IsForeignLoad o) => o -> m (Maybe Vips.Image.Image)
getForeignLoadOut :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> m (Maybe Image)
getForeignLoadOut o
obj = IO (Maybe Image) -> m (Maybe Image)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Image) -> m (Maybe Image))
-> IO (Maybe Image) -> m (Maybe Image)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Image -> Image) -> IO (Maybe Image)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"out" ManagedPtr Image -> Image
Vips.Image.Image

-- | Set the value of the “@out@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #out 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadOut :: (MonadIO m, IsForeignLoad o, Vips.Image.IsImage a) => o -> a -> m ()
setForeignLoadOut :: forall (m :: * -> *) o a.
(MonadIO m, IsForeignLoad o, IsImage a) =>
o -> a -> m ()
setForeignLoadOut o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"out" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@out@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadOut :: (IsForeignLoad o, MIO.MonadIO m, Vips.Image.IsImage a) => a -> m (GValueConstruct o)
constructForeignLoadOut :: forall o (m :: * -> *) a.
(IsForeignLoad o, MonadIO m, IsImage a) =>
a -> m (GValueConstruct o)
constructForeignLoadOut a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"out" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@out@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #out
-- @
clearForeignLoadOut :: (MonadIO m, IsForeignLoad o) => o -> m ()
clearForeignLoadOut :: forall (m :: * -> *) o. (MonadIO m, IsForeignLoad o) => o -> m ()
clearForeignLoadOut o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Image -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"out" (Maybe Image
forall a. Maybe a
Nothing :: Maybe Vips.Image.Image)

#if defined(ENABLE_OVERLOADING)
data ForeignLoadOutPropertyInfo
instance AttrInfo ForeignLoadOutPropertyInfo where
    type AttrAllowedOps ForeignLoadOutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ForeignLoadOutPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadOutPropertyInfo = Vips.Image.IsImage
    type AttrTransferTypeConstraint ForeignLoadOutPropertyInfo = Vips.Image.IsImage
    type AttrTransferType ForeignLoadOutPropertyInfo = Vips.Image.Image
    type AttrGetType ForeignLoadOutPropertyInfo = (Maybe Vips.Image.Image)
    type AttrLabel ForeignLoadOutPropertyInfo = "out"
    type AttrOrigin ForeignLoadOutPropertyInfo = ForeignLoad
    attrGet = getForeignLoadOut
    attrSet = setForeignLoadOut
    attrTransfer _ v = do
        unsafeCastTo Vips.Image.Image v
    attrConstruct = constructForeignLoadOut
    attrClear = clearForeignLoadOut
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.out"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:out"
        })
#endif

-- VVV Prop "sequential"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@sequential@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' foreignLoad #sequential
-- @
getForeignLoadSequential :: (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadSequential :: forall (m :: * -> *) o. (MonadIO m, IsForeignLoad o) => o -> m Bool
getForeignLoadSequential o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"sequential"

-- | Set the value of the “@sequential@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' foreignLoad [ #sequential 'Data.GI.Base.Attributes.:=' value ]
-- @
setForeignLoadSequential :: (MonadIO m, IsForeignLoad o) => o -> Bool -> m ()
setForeignLoadSequential :: forall (m :: * -> *) o.
(MonadIO m, IsForeignLoad o) =>
o -> Bool -> m ()
setForeignLoadSequential o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"sequential" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@sequential@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructForeignLoadSequential :: (IsForeignLoad o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructForeignLoadSequential :: forall o (m :: * -> *).
(IsForeignLoad o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructForeignLoadSequential Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"sequential" Bool
val

#if defined(ENABLE_OVERLOADING)
data ForeignLoadSequentialPropertyInfo
instance AttrInfo ForeignLoadSequentialPropertyInfo where
    type AttrAllowedOps ForeignLoadSequentialPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ForeignLoadSequentialPropertyInfo = IsForeignLoad
    type AttrSetTypeConstraint ForeignLoadSequentialPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ForeignLoadSequentialPropertyInfo = (~) Bool
    type AttrTransferType ForeignLoadSequentialPropertyInfo = Bool
    type AttrGetType ForeignLoadSequentialPropertyInfo = Bool
    type AttrLabel ForeignLoadSequentialPropertyInfo = "sequential"
    type AttrOrigin ForeignLoadSequentialPropertyInfo = ForeignLoad
    attrGet = getForeignLoadSequential
    attrSet = setForeignLoadSequential
    attrTransfer _ v = do
        return v
    attrConstruct = constructForeignLoadSequential
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.ForeignLoad.sequential"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Objects-ForeignLoad.html#g:attr:sequential"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ForeignLoad
type instance O.AttributeList ForeignLoad = ForeignLoadAttributeList
type ForeignLoadAttributeList = ('[ '("access", ForeignLoadAccessPropertyInfo), '("description", Vips.Object.ObjectDescriptionPropertyInfo), '("disc", ForeignLoadDiscPropertyInfo), '("fail", ForeignLoadFailPropertyInfo), '("flags", ForeignLoadFlagsPropertyInfo), '("memory", ForeignLoadMemoryPropertyInfo), '("nickname", Vips.Object.ObjectNicknamePropertyInfo), '("out", ForeignLoadOutPropertyInfo), '("sequential", ForeignLoadSequentialPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
foreignLoadAccess :: AttrLabelProxy "access"
foreignLoadAccess = AttrLabelProxy

foreignLoadDisc :: AttrLabelProxy "disc"
foreignLoadDisc = AttrLabelProxy

foreignLoadFail :: AttrLabelProxy "fail"
foreignLoadFail = AttrLabelProxy

foreignLoadFlags :: AttrLabelProxy "flags"
foreignLoadFlags = AttrLabelProxy

foreignLoadMemory :: AttrLabelProxy "memory"
foreignLoadMemory = AttrLabelProxy

foreignLoadOut :: AttrLabelProxy "out"
foreignLoadOut = AttrLabelProxy

foreignLoadSequential :: AttrLabelProxy "sequential"
foreignLoadSequential = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ForeignLoad = ForeignLoadSignalList
type ForeignLoadSignalList = ('[ '("close", Vips.Object.ObjectCloseSignalInfo), '("invalidate", Vips.Operation.OperationInvalidateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("postbuild", Vips.Object.ObjectPostbuildSignalInfo), '("postclose", Vips.Object.ObjectPostcloseSignalInfo), '("preclose", Vips.Object.ObjectPrecloseSignalInfo)] :: [(Symbol, *)])

#endif