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

-- * Exported types
    Thing(..)                               ,
    newZeroThing                            ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveThingMethod                      ,
#endif

-- ** new #method:new#

    thingNew                                ,




 -- * Properties


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

    getThingI                               ,
    setThingI                               ,
#if defined(ENABLE_OVERLOADING)
    thing_i                                 ,
#endif




    ) 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


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

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

foreign import ccall "vips_thing_get_type" c_vips_thing_get_type :: 
    IO GType

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

instance B.Types.TypedObject Thing where
    glibType :: IO GType
glibType = IO GType
c_vips_thing_get_type

instance B.Types.GBoxed Thing

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

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

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


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

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

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

thing_i :: AttrLabelProxy "i"
thing_i = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Thing
type instance O.AttributeList Thing = ThingAttributeList
type ThingAttributeList = ('[ '("i", ThingIFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Thing::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , 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 = "Thing" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_thing_new" vips_thing_new :: 
    Int32 ->                                -- i : TBasicType TInt
    IO (Ptr Thing)

-- | /No description available in the introspection data./
thingNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -> m Thing
    -- ^ __Returns:__ a new t'GI.Vips.Structs.Thing.Thing'.
thingNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m Thing
thingNew Int32
i = IO Thing -> m Thing
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Thing -> m Thing) -> IO Thing -> m Thing
forall a b. (a -> b) -> a -> b
$ do
    Ptr Thing
result <- Int32 -> IO (Ptr Thing)
vips_thing_new Int32
i
    Text -> Ptr Thing -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"thingNew" Ptr Thing
result
    Thing
result' <- ((ManagedPtr Thing -> Thing) -> Ptr Thing -> IO Thing
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Thing -> Thing
Thing) Ptr Thing
result
    Thing -> IO Thing
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Thing
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif