{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkTextureDownloader@ is used to download the contents of a
-- t'GI.Gdk.Objects.Texture.Texture'.
-- 
-- It is intended to be created as a short-term object for a single download,
-- but can be used for multiple downloads of different textures or with different
-- settings.
-- 
-- @GdkTextureDownloader@ can be used to convert data between different formats.
-- Create a @GdkTexture@ for the existing format and then download it in a
-- different format.
-- 
-- /Since: 4.10/

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gdk.Structs.TextureDownloader
    ( 

-- * Exported types
    TextureDownloader(..)                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gdk.Structs.TextureDownloader#g:method:copy"), [downloadBytes]("GI.Gdk.Structs.TextureDownloader#g:method:downloadBytes"), [downloadInto]("GI.Gdk.Structs.TextureDownloader#g:method:downloadInto"), [free]("GI.Gdk.Structs.TextureDownloader#g:method:free").
-- 
-- ==== Getters
-- [getFormat]("GI.Gdk.Structs.TextureDownloader#g:method:getFormat"), [getTexture]("GI.Gdk.Structs.TextureDownloader#g:method:getTexture").
-- 
-- ==== Setters
-- [setFormat]("GI.Gdk.Structs.TextureDownloader#g:method:setFormat"), [setTexture]("GI.Gdk.Structs.TextureDownloader#g:method:setTexture").

#if defined(ENABLE_OVERLOADING)
    ResolveTextureDownloaderMethod          ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderCopyMethodInfo         ,
#endif
    textureDownloaderCopy                   ,


-- ** downloadBytes #method:downloadBytes#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderDownloadBytesMethodInfo,
#endif
    textureDownloaderDownloadBytes          ,


-- ** downloadInto #method:downloadInto#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderDownloadIntoMethodInfo ,
#endif
    textureDownloaderDownloadInto           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderFreeMethodInfo         ,
#endif
    textureDownloaderFree                   ,


-- ** getFormat #method:getFormat#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderGetFormatMethodInfo    ,
#endif
    textureDownloaderGetFormat              ,


-- ** getTexture #method:getTexture#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderGetTextureMethodInfo   ,
#endif
    textureDownloaderGetTexture             ,


-- ** new #method:new#

    textureDownloaderNew                    ,


-- ** setFormat #method:setFormat#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderSetFormatMethodInfo    ,
#endif
    textureDownloaderSetFormat              ,


-- ** setTexture #method:setTexture#

#if defined(ENABLE_OVERLOADING)
    TextureDownloaderSetTextureMethodInfo   ,
#endif
    textureDownloaderSetTexture             ,




    ) 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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon

#else
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture

#endif

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

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

foreign import ccall "gdk_texture_downloader_get_type" c_gdk_texture_downloader_get_type :: 
    IO GType

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

instance B.Types.TypedObject TextureDownloader where
    glibType :: IO GType
glibType = IO GType
c_gdk_texture_downloader_get_type

instance B.Types.GBoxed TextureDownloader

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TextureDownloader
type instance O.AttributeList TextureDownloader = TextureDownloaderAttributeList
type TextureDownloaderAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method TextureDownloader::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "texture to download"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gdk" , name = "TextureDownloader" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_new" gdk_texture_downloader_new :: 
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO (Ptr TextureDownloader)

-- | Creates a new texture downloader for /@texture@/.
-- 
-- /Since: 4.10/
textureDownloaderNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Texture.IsTexture a) =>
    a
    -- ^ /@texture@/: texture to download
    -> m TextureDownloader
    -- ^ __Returns:__ A new texture downloader
textureDownloaderNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m TextureDownloader
textureDownloaderNew a
texture = IO TextureDownloader -> m TextureDownloader
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextureDownloader -> m TextureDownloader)
-> IO TextureDownloader -> m TextureDownloader
forall a b. (a -> b) -> a -> b
$ do
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    result <- gdk_texture_downloader_new texture'
    checkUnexpectedReturnNULL "textureDownloaderNew" result
    result' <- (wrapBoxed TextureDownloader) result
    touchManagedPtr texture
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextureDownloader::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the downloader to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gdk" , name = "TextureDownloader" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_copy" gdk_texture_downloader_copy :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    IO (Ptr TextureDownloader)

-- | Creates a copy of the downloader.
-- 
-- This function is meant for language bindings.
-- 
-- /Since: 4.10/
textureDownloaderCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: the downloader to copy
    -> m TextureDownloader
    -- ^ __Returns:__ A copy of the downloader
textureDownloaderCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> m TextureDownloader
textureDownloaderCopy TextureDownloader
self = IO TextureDownloader -> m TextureDownloader
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextureDownloader -> m TextureDownloader)
-> IO TextureDownloader -> m TextureDownloader
forall a b. (a -> b) -> a -> b
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    result <- gdk_texture_downloader_copy self'
    checkUnexpectedReturnNULL "textureDownloaderCopy" result
    result' <- (wrapBoxed TextureDownloader) result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderCopyMethodInfo
instance (signature ~ (m TextureDownloader), MonadIO m) => O.OverloadedMethod TextureDownloaderCopyMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderCopy

instance O.OverloadedMethodInfo TextureDownloaderCopyMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderCopy"
        })


#endif

-- method TextureDownloader::download_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the downloader" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_stride"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The stride of the resulting data in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_download_bytes" gdk_texture_downloader_download_bytes :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    Ptr FCT.CSize ->                        -- out_stride : TBasicType TSize
    IO (Ptr GLib.Bytes.Bytes)

-- | Downloads the given texture pixels into a @GBytes@. The rowstride will
-- be stored in the stride value.
-- 
-- This function will abort if it tries to download a large texture and
-- fails to allocate memory. If you think that may happen, you should handle
-- memory allocation yourself and use 'GI.Gdk.Structs.TextureDownloader.textureDownloaderDownloadInto'
-- once allocation succeeded.
-- 
-- /Since: 4.10/
textureDownloaderDownloadBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: the downloader
    -> m ((GLib.Bytes.Bytes, FCT.CSize))
    -- ^ __Returns:__ The downloaded pixels
textureDownloaderDownloadBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> m (Bytes, CSize)
textureDownloaderDownloadBytes TextureDownloader
self = IO (Bytes, CSize) -> m (Bytes, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bytes, CSize) -> m (Bytes, CSize))
-> IO (Bytes, CSize) -> m (Bytes, CSize)
forall a b. (a -> b) -> a -> b
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    outStride <- allocMem :: IO (Ptr FCT.CSize)
    result <- gdk_texture_downloader_download_bytes self' outStride
    checkUnexpectedReturnNULL "textureDownloaderDownloadBytes" result
    result' <- (wrapBoxed GLib.Bytes.Bytes) result
    outStride' <- peek outStride
    touchManagedPtr self
    freeMem outStride
    return (result', outStride')

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderDownloadBytesMethodInfo
instance (signature ~ (m ((GLib.Bytes.Bytes, FCT.CSize))), MonadIO m) => O.OverloadedMethod TextureDownloaderDownloadBytesMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderDownloadBytes

instance O.OverloadedMethodInfo TextureDownloaderDownloadBytesMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderDownloadBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderDownloadBytes"
        })


#endif

-- method TextureDownloader::download_into
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a texture downloader"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to enough memory to be filled with the\n  downloaded data of the texture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rowstride in bytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_download_into" gdk_texture_downloader_download_into :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    Ptr Word8 ->                            -- data : TCArray False (-1) (-1) (TBasicType TUInt8)
    FCT.CSize ->                            -- stride : TBasicType TSize
    IO ()

-- | Downloads the /@texture@/ into local memory.
-- 
-- /Since: 4.10/
textureDownloaderDownloadInto ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: a texture downloader
    -> Ptr Word8
    -- ^ /@data@/: pointer to enough memory to be filled with the
    --   downloaded data of the texture
    -> FCT.CSize
    -- ^ /@stride@/: rowstride in bytes
    -> m ()
textureDownloaderDownloadInto :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> Ptr Word8 -> CSize -> m ()
textureDownloaderDownloadInto TextureDownloader
self Ptr Word8
data_ CSize
stride = 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
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    gdk_texture_downloader_download_into self' data_ stride
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderDownloadIntoMethodInfo
instance (signature ~ (Ptr Word8 -> FCT.CSize -> m ()), MonadIO m) => O.OverloadedMethod TextureDownloaderDownloadIntoMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderDownloadInto

instance O.OverloadedMethodInfo TextureDownloaderDownloadIntoMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderDownloadInto",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderDownloadInto"
        })


#endif

-- method TextureDownloader::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "texture downloader to free"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_free" gdk_texture_downloader_free :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    IO ()

-- | Frees the given downloader and all its associated resources.
-- 
-- /Since: 4.10/
textureDownloaderFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: texture downloader to free
    -> m ()
textureDownloaderFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> m ()
textureDownloaderFree TextureDownloader
self = 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
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    gdk_texture_downloader_free self'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TextureDownloaderFreeMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderFree

instance O.OverloadedMethodInfo TextureDownloaderFreeMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderFree"
        })


#endif

-- method TextureDownloader::get_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a texture downloader"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "MemoryFormat" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_get_format" gdk_texture_downloader_get_format :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    IO CUInt

-- | Gets the format that the data will be downloaded in.
-- 
-- /Since: 4.10/
textureDownloaderGetFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: a texture downloader
    -> m Gdk.Enums.MemoryFormat
    -- ^ __Returns:__ The format of the download
textureDownloaderGetFormat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> m MemoryFormat
textureDownloaderGetFormat TextureDownloader
self = IO MemoryFormat -> m MemoryFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryFormat -> m MemoryFormat)
-> IO MemoryFormat -> m MemoryFormat
forall a b. (a -> b) -> a -> b
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    result <- gdk_texture_downloader_get_format self'
    let result' = (Int -> MemoryFormat
forall a. Enum a => Int -> a
toEnum (Int -> MemoryFormat) -> (CUInt -> Int) -> CUInt -> MemoryFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderGetFormatMethodInfo
instance (signature ~ (m Gdk.Enums.MemoryFormat), MonadIO m) => O.OverloadedMethod TextureDownloaderGetFormatMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderGetFormat

instance O.OverloadedMethodInfo TextureDownloaderGetFormatMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderGetFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderGetFormat"
        })


#endif

-- method TextureDownloader::get_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a texture downloader"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_get_texture" gdk_texture_downloader_get_texture :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    IO (Ptr Gdk.Texture.Texture)

-- | Gets the texture that the downloader will download.
-- 
-- /Since: 4.10/
textureDownloaderGetTexture ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: a texture downloader
    -> m Gdk.Texture.Texture
    -- ^ __Returns:__ The texture to download
textureDownloaderGetTexture :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> m Texture
textureDownloaderGetTexture TextureDownloader
self = IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    result <- gdk_texture_downloader_get_texture self'
    checkUnexpectedReturnNULL "textureDownloaderGetTexture" result
    result' <- (newObject Gdk.Texture.Texture) result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderGetTextureMethodInfo
instance (signature ~ (m Gdk.Texture.Texture), MonadIO m) => O.OverloadedMethod TextureDownloaderGetTextureMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderGetTexture

instance O.OverloadedMethodInfo TextureDownloaderGetTextureMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderGetTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderGetTexture"
        })


#endif

-- method TextureDownloader::set_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a texture downloader"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "MemoryFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_set_format" gdk_texture_downloader_set_format :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gdk", name = "MemoryFormat"})
    IO ()

-- | Sets the format the downloader will download.
-- 
-- By default, GDK_MEMORY_DEFAULT is set.
-- 
-- /Since: 4.10/
textureDownloaderSetFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextureDownloader
    -- ^ /@self@/: a texture downloader
    -> Gdk.Enums.MemoryFormat
    -- ^ /@format@/: the format to use
    -> m ()
textureDownloaderSetFormat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextureDownloader -> MemoryFormat -> m ()
textureDownloaderSetFormat TextureDownloader
self MemoryFormat
format = 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
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    let format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (MemoryFormat -> Int) -> MemoryFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryFormat -> Int
forall a. Enum a => a -> Int
fromEnum) MemoryFormat
format
    gdk_texture_downloader_set_format self' format'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderSetFormatMethodInfo
instance (signature ~ (Gdk.Enums.MemoryFormat -> m ()), MonadIO m) => O.OverloadedMethod TextureDownloaderSetFormatMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderSetFormat

instance O.OverloadedMethodInfo TextureDownloaderSetFormatMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderSetFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderSetFormat"
        })


#endif

-- method TextureDownloader::set_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "TextureDownloader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a texture downloader"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new texture to download"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_downloader_set_texture" gdk_texture_downloader_set_texture :: 
    Ptr TextureDownloader ->                -- self : TInterface (Name {namespace = "Gdk", name = "TextureDownloader"})
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO ()

-- | Changes the texture the downloader will download.
-- 
-- /Since: 4.10/
textureDownloaderSetTexture ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Texture.IsTexture a) =>
    TextureDownloader
    -- ^ /@self@/: a texture downloader
    -> a
    -- ^ /@texture@/: the new texture to download
    -> m ()
textureDownloaderSetTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
TextureDownloader -> a -> m ()
textureDownloaderSetTexture TextureDownloader
self a
texture = 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
$ do
    self' <- TextureDownloader -> IO (Ptr TextureDownloader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextureDownloader
self
    texture' <- unsafeManagedPtrCastPtr texture
    gdk_texture_downloader_set_texture self' texture'
    touchManagedPtr self
    touchManagedPtr texture
    return ()

#if defined(ENABLE_OVERLOADING)
data TextureDownloaderSetTextureMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gdk.Texture.IsTexture a) => O.OverloadedMethod TextureDownloaderSetTextureMethodInfo TextureDownloader signature where
    overloadedMethod = textureDownloaderSetTexture

instance O.OverloadedMethodInfo TextureDownloaderSetTextureMethodInfo TextureDownloader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.TextureDownloader.textureDownloaderSetTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-TextureDownloader.html#v:textureDownloaderSetTexture"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTextureDownloaderMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextureDownloaderMethod "copy" o = TextureDownloaderCopyMethodInfo
    ResolveTextureDownloaderMethod "downloadBytes" o = TextureDownloaderDownloadBytesMethodInfo
    ResolveTextureDownloaderMethod "downloadInto" o = TextureDownloaderDownloadIntoMethodInfo
    ResolveTextureDownloaderMethod "free" o = TextureDownloaderFreeMethodInfo
    ResolveTextureDownloaderMethod "getFormat" o = TextureDownloaderGetFormatMethodInfo
    ResolveTextureDownloaderMethod "getTexture" o = TextureDownloaderGetTextureMethodInfo
    ResolveTextureDownloaderMethod "setFormat" o = TextureDownloaderSetFormatMethodInfo
    ResolveTextureDownloaderMethod "setTexture" o = TextureDownloaderSetTextureMethodInfo
    ResolveTextureDownloaderMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif