{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A GdkContentProvider is used to provide content for the clipboard in
-- a number of formats.
-- 
-- To create a GdkContentProvider, use 'GI.Gdk.Objects.ContentProvider.contentProviderNewForValue' or
-- 'GI.Gdk.Objects.ContentProvider.contentProviderNewForBytes'.
-- 
-- GDK knows how to handle common text and image formats out-of-the-box. See
-- t'GI.Gdk.Objects.ContentSerializer.ContentSerializer' and t'GI.Gdk.Objects.ContentDeserializer.ContentDeserializer' if you want to add support
-- for application-specific data formats.

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

module GI.Gdk.Objects.ContentProvider
    ( 

-- * Exported types
    ContentProvider(..)                     ,
    IsContentProvider                       ,
    toContentProvider                       ,
    noContentProvider                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContentProviderMethod            ,
#endif


-- ** contentChanged #method:contentChanged#

#if defined(ENABLE_OVERLOADING)
    ContentProviderContentChangedMethodInfo ,
#endif
    contentProviderContentChanged           ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    ContentProviderGetValueMethodInfo       ,
#endif
    contentProviderGetValue                 ,


-- ** newForBytes #method:newForBytes#

    contentProviderNewForBytes              ,


-- ** newForValue #method:newForValue#

    contentProviderNewForValue              ,


-- ** refFormats #method:refFormats#

#if defined(ENABLE_OVERLOADING)
    ContentProviderRefFormatsMethodInfo     ,
#endif
    contentProviderRefFormats               ,


-- ** refStorableFormats #method:refStorableFormats#

#if defined(ENABLE_OVERLOADING)
    ContentProviderRefStorableFormatsMethodInfo,
#endif
    contentProviderRefStorableFormats       ,


-- ** writeMimeTypeAsync #method:writeMimeTypeAsync#

#if defined(ENABLE_OVERLOADING)
    ContentProviderWriteMimeTypeAsyncMethodInfo,
#endif
    contentProviderWriteMimeTypeAsync       ,


-- ** writeMimeTypeFinish #method:writeMimeTypeFinish#

#if defined(ENABLE_OVERLOADING)
    ContentProviderWriteMimeTypeFinishMethodInfo,
#endif
    contentProviderWriteMimeTypeFinish      ,




 -- * Properties
-- ** formats #attr:formats#
-- | The possible formats that the provider can provide its data in.

#if defined(ENABLE_OVERLOADING)
    ContentProviderFormatsPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    contentProviderFormats                  ,
#endif
    getContentProviderFormats               ,


-- ** storableFormats #attr:storableFormats#
-- | The subset of formats that clipboard managers should store this provider\'s data in.

#if defined(ENABLE_OVERLOADING)
    ContentProviderStorableFormatsPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    contentProviderStorableFormats          ,
#endif
    getContentProviderStorableFormats       ,




 -- * Signals
-- ** contentChanged #signal:contentChanged#

    C_ContentProviderContentChangedCallback ,
    ContentProviderContentChangedCallback   ,
#if defined(ENABLE_OVERLOADING)
    ContentProviderContentChangedSignalInfo ,
#endif
    afterContentProviderContentChanged      ,
    genClosure_ContentProviderContentChanged,
    mk_ContentProviderContentChangedCallback,
    noContentProviderContentChangedCallback ,
    onContentProviderContentChanged         ,
    wrap_ContentProviderContentChangedCallback,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream

-- | Memory-managed wrapper type.
newtype ContentProvider = ContentProvider (ManagedPtr ContentProvider)
    deriving (ContentProvider -> ContentProvider -> Bool
(ContentProvider -> ContentProvider -> Bool)
-> (ContentProvider -> ContentProvider -> Bool)
-> Eq ContentProvider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentProvider -> ContentProvider -> Bool
$c/= :: ContentProvider -> ContentProvider -> Bool
== :: ContentProvider -> ContentProvider -> Bool
$c== :: ContentProvider -> ContentProvider -> Bool
Eq)
foreign import ccall "gdk_content_provider_get_type"
    c_gdk_content_provider_get_type :: IO GType

instance GObject ContentProvider where
    gobjectType :: IO GType
gobjectType = IO GType
c_gdk_content_provider_get_type
    

-- | Convert 'ContentProvider' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue ContentProvider where
    toGValue :: ContentProvider -> IO GValue
toGValue o :: ContentProvider
o = do
        GType
gtype <- IO GType
c_gdk_content_provider_get_type
        ContentProvider -> (Ptr ContentProvider -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ContentProvider
o (GType
-> (GValue -> Ptr ContentProvider -> IO ())
-> Ptr ContentProvider
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr ContentProvider -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO ContentProvider
fromGValue gv :: GValue
gv = do
        Ptr ContentProvider
ptr <- GValue -> IO (Ptr ContentProvider)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr ContentProvider)
        (ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ContentProvider -> ContentProvider
ContentProvider Ptr ContentProvider
ptr
        
    

-- | Type class for types which can be safely cast to `ContentProvider`, for instance with `toContentProvider`.
class (GObject o, O.IsDescendantOf ContentProvider o) => IsContentProvider o
instance (GObject o, O.IsDescendantOf ContentProvider o) => IsContentProvider o

instance O.HasParentTypes ContentProvider
type instance O.ParentTypes ContentProvider = '[GObject.Object.Object]

-- | Cast to `ContentProvider`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toContentProvider :: (MonadIO m, IsContentProvider o) => o -> m ContentProvider
toContentProvider :: o -> m ContentProvider
toContentProvider = IO ContentProvider -> m ContentProvider
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentProvider -> m ContentProvider)
-> (o -> IO ContentProvider) -> o -> m ContentProvider
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ContentProvider -> ContentProvider)
-> o -> IO ContentProvider
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr ContentProvider -> ContentProvider
ContentProvider

-- | A convenience alias for `Nothing` :: `Maybe` `ContentProvider`.
noContentProvider :: Maybe ContentProvider
noContentProvider :: Maybe ContentProvider
noContentProvider = Maybe ContentProvider
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContentProviderMethod (t :: Symbol) (o :: *) :: * where
    ResolveContentProviderMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContentProviderMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContentProviderMethod "contentChanged" o = ContentProviderContentChangedMethodInfo
    ResolveContentProviderMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContentProviderMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContentProviderMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContentProviderMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContentProviderMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContentProviderMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContentProviderMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContentProviderMethod "refFormats" o = ContentProviderRefFormatsMethodInfo
    ResolveContentProviderMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContentProviderMethod "refStorableFormats" o = ContentProviderRefStorableFormatsMethodInfo
    ResolveContentProviderMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContentProviderMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContentProviderMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContentProviderMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContentProviderMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContentProviderMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContentProviderMethod "writeMimeTypeAsync" o = ContentProviderWriteMimeTypeAsyncMethodInfo
    ResolveContentProviderMethod "writeMimeTypeFinish" o = ContentProviderWriteMimeTypeFinishMethodInfo
    ResolveContentProviderMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContentProviderMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContentProviderMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContentProviderMethod "getValue" o = ContentProviderGetValueMethodInfo
    ResolveContentProviderMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContentProviderMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContentProviderMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContentProviderMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContentProviderMethod t ContentProvider, O.MethodInfo info ContentProvider p) => OL.IsLabel t (ContentProvider -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal ContentProvider::content-changed
-- | /No description available in the introspection data./
type ContentProviderContentChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ContentProviderContentChangedCallback`@.
noContentProviderContentChangedCallback :: Maybe ContentProviderContentChangedCallback
noContentProviderContentChangedCallback :: Maybe (IO ())
noContentProviderContentChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ContentProviderContentChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ContentProviderContentChangedCallback`.
foreign import ccall "wrapper"
    mk_ContentProviderContentChangedCallback :: C_ContentProviderContentChangedCallback -> IO (FunPtr C_ContentProviderContentChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ContentProviderContentChanged :: MonadIO m => ContentProviderContentChangedCallback -> m (GClosure C_ContentProviderContentChangedCallback)
genClosure_ContentProviderContentChanged :: IO () -> m (GClosure C_ContentProviderContentChangedCallback)
genClosure_ContentProviderContentChanged cb :: IO ()
cb = IO (GClosure C_ContentProviderContentChangedCallback)
-> m (GClosure C_ContentProviderContentChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ContentProviderContentChangedCallback)
 -> m (GClosure C_ContentProviderContentChangedCallback))
-> IO (GClosure C_ContentProviderContentChangedCallback)
-> m (GClosure C_ContentProviderContentChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContentProviderContentChangedCallback
cb' = IO () -> C_ContentProviderContentChangedCallback
wrap_ContentProviderContentChangedCallback IO ()
cb
    C_ContentProviderContentChangedCallback
-> IO (FunPtr C_ContentProviderContentChangedCallback)
mk_ContentProviderContentChangedCallback C_ContentProviderContentChangedCallback
cb' IO (FunPtr C_ContentProviderContentChangedCallback)
-> (FunPtr C_ContentProviderContentChangedCallback
    -> IO (GClosure C_ContentProviderContentChangedCallback))
-> IO (GClosure C_ContentProviderContentChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ContentProviderContentChangedCallback
-> IO (GClosure C_ContentProviderContentChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ContentProviderContentChangedCallback` into a `C_ContentProviderContentChangedCallback`.
wrap_ContentProviderContentChangedCallback ::
    ContentProviderContentChangedCallback ->
    C_ContentProviderContentChangedCallback
wrap_ContentProviderContentChangedCallback :: IO () -> C_ContentProviderContentChangedCallback
wrap_ContentProviderContentChangedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [contentChanged](#signal:contentChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' contentProvider #contentChanged callback
-- @
-- 
-- 
onContentProviderContentChanged :: (IsContentProvider a, MonadIO m) => a -> ContentProviderContentChangedCallback -> m SignalHandlerId
onContentProviderContentChanged :: a -> IO () -> m SignalHandlerId
onContentProviderContentChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContentProviderContentChangedCallback
cb' = IO () -> C_ContentProviderContentChangedCallback
wrap_ContentProviderContentChangedCallback IO ()
cb
    FunPtr C_ContentProviderContentChangedCallback
cb'' <- C_ContentProviderContentChangedCallback
-> IO (FunPtr C_ContentProviderContentChangedCallback)
mk_ContentProviderContentChangedCallback C_ContentProviderContentChangedCallback
cb'
    a
-> Text
-> FunPtr C_ContentProviderContentChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "content-changed" FunPtr C_ContentProviderContentChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [contentChanged](#signal:contentChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' contentProvider #contentChanged callback
-- @
-- 
-- 
afterContentProviderContentChanged :: (IsContentProvider a, MonadIO m) => a -> ContentProviderContentChangedCallback -> m SignalHandlerId
afterContentProviderContentChanged :: a -> IO () -> m SignalHandlerId
afterContentProviderContentChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ContentProviderContentChangedCallback
cb' = IO () -> C_ContentProviderContentChangedCallback
wrap_ContentProviderContentChangedCallback IO ()
cb
    FunPtr C_ContentProviderContentChangedCallback
cb'' <- C_ContentProviderContentChangedCallback
-> IO (FunPtr C_ContentProviderContentChangedCallback)
mk_ContentProviderContentChangedCallback C_ContentProviderContentChangedCallback
cb'
    a
-> Text
-> FunPtr C_ContentProviderContentChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "content-changed" FunPtr C_ContentProviderContentChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContentProviderContentChangedSignalInfo
instance SignalInfo ContentProviderContentChangedSignalInfo where
    type HaskellCallbackType ContentProviderContentChangedSignalInfo = ContentProviderContentChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContentProviderContentChangedCallback cb
        cb'' <- mk_ContentProviderContentChangedCallback cb'
        connectSignalFunPtr obj "content-changed" cb'' connectMode detail

#endif

-- VVV Prop "formats"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@formats@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' contentProvider #formats
-- @
getContentProviderFormats :: (MonadIO m, IsContentProvider o) => o -> m (Maybe Gdk.ContentFormats.ContentFormats)
getContentProviderFormats :: o -> m (Maybe ContentFormats)
getContentProviderFormats obj :: o
obj = IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentFormats) -> m (Maybe ContentFormats))
-> IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ContentFormats -> ContentFormats)
-> IO (Maybe ContentFormats)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "formats" ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats

#if defined(ENABLE_OVERLOADING)
data ContentProviderFormatsPropertyInfo
instance AttrInfo ContentProviderFormatsPropertyInfo where
    type AttrAllowedOps ContentProviderFormatsPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ContentProviderFormatsPropertyInfo = IsContentProvider
    type AttrSetTypeConstraint ContentProviderFormatsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ContentProviderFormatsPropertyInfo = (~) ()
    type AttrTransferType ContentProviderFormatsPropertyInfo = ()
    type AttrGetType ContentProviderFormatsPropertyInfo = (Maybe Gdk.ContentFormats.ContentFormats)
    type AttrLabel ContentProviderFormatsPropertyInfo = "formats"
    type AttrOrigin ContentProviderFormatsPropertyInfo = ContentProvider
    attrGet = getContentProviderFormats
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "storable-formats"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@storable-formats@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' contentProvider #storableFormats
-- @
getContentProviderStorableFormats :: (MonadIO m, IsContentProvider o) => o -> m (Maybe Gdk.ContentFormats.ContentFormats)
getContentProviderStorableFormats :: o -> m (Maybe ContentFormats)
getContentProviderStorableFormats obj :: o
obj = IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentFormats) -> m (Maybe ContentFormats))
-> IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ContentFormats -> ContentFormats)
-> IO (Maybe ContentFormats)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "storable-formats" ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats

#if defined(ENABLE_OVERLOADING)
data ContentProviderStorableFormatsPropertyInfo
instance AttrInfo ContentProviderStorableFormatsPropertyInfo where
    type AttrAllowedOps ContentProviderStorableFormatsPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ContentProviderStorableFormatsPropertyInfo = IsContentProvider
    type AttrSetTypeConstraint ContentProviderStorableFormatsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ContentProviderStorableFormatsPropertyInfo = (~) ()
    type AttrTransferType ContentProviderStorableFormatsPropertyInfo = ()
    type AttrGetType ContentProviderStorableFormatsPropertyInfo = (Maybe Gdk.ContentFormats.ContentFormats)
    type AttrLabel ContentProviderStorableFormatsPropertyInfo = "storable-formats"
    type AttrOrigin ContentProviderStorableFormatsPropertyInfo = ContentProvider
    attrGet = getContentProviderStorableFormats
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ContentProvider
type instance O.AttributeList ContentProvider = ContentProviderAttributeList
type ContentProviderAttributeList = ('[ '("formats", ContentProviderFormatsPropertyInfo), '("storableFormats", ContentProviderStorableFormatsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
contentProviderFormats :: AttrLabelProxy "formats"
contentProviderFormats = AttrLabelProxy

contentProviderStorableFormats :: AttrLabelProxy "storableFormats"
contentProviderStorableFormats = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ContentProvider = ContentProviderSignalList
type ContentProviderSignalList = ('[ '("contentChanged", ContentProviderContentChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ContentProvider::new_for_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes with the data for @mime_type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentProvider" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_new_for_bytes" gdk_content_provider_new_for_bytes :: 
    CString ->                              -- mime_type : TBasicType TUTF8
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    IO (Ptr ContentProvider)

-- | Create a content provider that provides the given /@bytes@/ as data for
-- the given /@mimeType@/.
contentProviderNewForBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@mimeType@/: the mime type
    -> GLib.Bytes.Bytes
    -- ^ /@bytes@/: a t'GI.GLib.Structs.Bytes.Bytes' with the data for /@mimeType@/
    -> m ContentProvider
    -- ^ __Returns:__ a new t'GI.Gdk.Objects.ContentProvider.ContentProvider'
contentProviderNewForBytes :: Text -> Bytes -> m ContentProvider
contentProviderNewForBytes mimeType :: Text
mimeType bytes :: Bytes
bytes = IO ContentProvider -> m ContentProvider
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentProvider -> m ContentProvider)
-> IO ContentProvider -> m ContentProvider
forall a b. (a -> b) -> a -> b
$ do
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr ContentProvider
result <- CString -> Ptr Bytes -> IO (Ptr ContentProvider)
gdk_content_provider_new_for_bytes CString
mimeType' Ptr Bytes
bytes'
    Text -> Ptr ContentProvider -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentProviderNewForBytes" Ptr ContentProvider
result
    ContentProvider
result' <- ((ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ContentProvider -> ContentProvider
ContentProvider) Ptr ContentProvider
result
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    ContentProvider -> IO ContentProvider
forall (m :: * -> *) a. Monad m => a -> m a
return ContentProvider
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContentProvider::new_for_value
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentProvider" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_new_for_value" gdk_content_provider_new_for_value :: 
    Ptr GValue ->                           -- value : TInterface (Name {namespace = "GObject", name = "Value"})
    IO (Ptr ContentProvider)

-- | Create a content provider that provides the given /@value@/.
contentProviderNewForValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m ContentProvider
    -- ^ __Returns:__ a new t'GI.Gdk.Objects.ContentProvider.ContentProvider'
contentProviderNewForValue :: GValue -> m ContentProvider
contentProviderNewForValue value :: GValue
value = IO ContentProvider -> m ContentProvider
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentProvider -> m ContentProvider)
-> IO ContentProvider -> m ContentProvider
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr ContentProvider
result <- Ptr GValue -> IO (Ptr ContentProvider)
gdk_content_provider_new_for_value Ptr GValue
value'
    Text -> Ptr ContentProvider -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentProviderNewForValue" Ptr ContentProvider
result
    ContentProvider
result' <- ((ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ContentProvider -> ContentProvider
ContentProvider) Ptr ContentProvider
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    ContentProvider -> IO ContentProvider
forall (m :: * -> *) a. Monad m => a -> m a
return ContentProvider
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContentProvider::content_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_content_changed" gdk_content_provider_content_changed :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    IO ()

-- | Emits the t'GI.Gdk.Objects.ContentProvider.ContentProvider'::@/contents-changed/@ signal.
contentProviderContentChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> m ()
contentProviderContentChanged :: a -> m ()
contentProviderContentChanged provider :: a
provider = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    Ptr ContentProvider -> IO ()
gdk_content_provider_content_changed Ptr ContentProvider
provider'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContentProviderContentChangedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContentProvider a) => O.MethodInfo ContentProviderContentChangedMethodInfo a signature where
    overloadedMethod = contentProviderContentChanged

#endif

-- method ContentProvider::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GValue to fill"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_content_provider_get_value" gdk_content_provider_get_value :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    Ptr GValue ->                           -- value : TInterface (Name {namespace = "GObject", name = "Value"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the convtents of /@provider@/ stored in /@value@/.
-- 
-- The /@value@/ will have been initialized to the t'GType' the value should be
-- provided in. This given t'GType' does not need to be listed in the formats
-- returned by 'GI.Gdk.Objects.ContentProvider.contentProviderRefFormats'. However, if the given
-- t'GType' is not supported, this operation can fail and
-- @/G_IO_ERROR_NOT_SUPPORTED/@ will be reported.
contentProviderGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> GValue
    -- ^ /@value@/: the t'GI.GObject.Structs.Value.Value' to fill
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
contentProviderGetValue :: a -> GValue -> m ()
contentProviderGetValue provider :: a
provider value :: GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ContentProvider -> Ptr GValue -> Ptr (Ptr GError) -> IO CInt
gdk_content_provider_get_value Ptr ContentProvider
provider' Ptr GValue
value'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
        GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ContentProviderGetValueMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m, IsContentProvider a) => O.MethodInfo ContentProviderGetValueMethodInfo a signature where
    overloadedMethod = contentProviderGetValue

#endif

-- method ContentProvider::ref_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_ref_formats" gdk_content_provider_ref_formats :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    IO (Ptr Gdk.ContentFormats.ContentFormats)

-- | Gets the formats that the provider can provide its current contents in.
contentProviderRefFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> m Gdk.ContentFormats.ContentFormats
    -- ^ __Returns:__ The formats of the provider
contentProviderRefFormats :: a -> m ContentFormats
contentProviderRefFormats provider :: a
provider = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    Ptr ContentFormats
result <- Ptr ContentProvider -> IO (Ptr ContentFormats)
gdk_content_provider_ref_formats Ptr ContentProvider
provider'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentProviderRefFormats" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats) Ptr ContentFormats
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentProviderRefFormatsMethodInfo
instance (signature ~ (m Gdk.ContentFormats.ContentFormats), MonadIO m, IsContentProvider a) => O.MethodInfo ContentProviderRefFormatsMethodInfo a signature where
    overloadedMethod = contentProviderRefFormats

#endif

-- method ContentProvider::ref_storable_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_ref_storable_formats" gdk_content_provider_ref_storable_formats :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    IO (Ptr Gdk.ContentFormats.ContentFormats)

-- | Gets the formats that the provider suggests other applications to store
-- the data in.
-- An example of such an application would be a clipboard manager.
-- 
-- This can be assumed to be a subset of 'GI.Gdk.Objects.ContentProvider.contentProviderRefFormats'.
contentProviderRefStorableFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> m Gdk.ContentFormats.ContentFormats
    -- ^ __Returns:__ The storable formats of the provider
contentProviderRefStorableFormats :: a -> m ContentFormats
contentProviderRefStorableFormats provider :: a
provider = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    Ptr ContentFormats
result <- Ptr ContentProvider -> IO (Ptr ContentFormats)
gdk_content_provider_ref_storable_formats Ptr ContentProvider
provider'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentProviderRefStorableFormats" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats) Ptr ContentFormats
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentProviderRefStorableFormatsMethodInfo
instance (signature ~ (m Gdk.ContentFormats.ContentFormats), MonadIO m, IsContentProvider a) => O.MethodInfo ContentProviderRefStorableFormatsMethodInfo a signature where
    overloadedMethod = contentProviderRefStorableFormats

#endif

-- method ContentProvider::write_mime_type_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type to provide the data in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GOutputStream to write to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority]\nof the request."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_provider_write_mime_type_async" gdk_content_provider_write_mime_type_async :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    CString ->                              -- mime_type : TBasicType TUTF8
    Ptr Gio.OutputStream.OutputStream ->    -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously writes the contents of /@provider@/ to /@stream@/ in the given
-- /@mimeType@/. When the operation is finished /@callback@/ will be called. You
-- can then call 'GI.Gdk.Objects.ContentProvider.contentProviderWriteMimeTypeFinish' to get the
-- result of the operation.
-- 
-- The given mime type does not need to be listed in the formats returned by
-- 'GI.Gdk.Objects.ContentProvider.contentProviderRefFormats'. However, if the given t'GType' is not
-- supported, @/G_IO_ERROR_NOT_SUPPORTED/@ will be reported.
-- 
-- The given /@stream@/ will not be closed.
contentProviderWriteMimeTypeAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> T.Text
    -- ^ /@mimeType@/: the mime type to provide the data in
    -> b
    -- ^ /@stream@/: the t'GI.Gio.Objects.OutputStream.OutputStream' to write to
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority]
    -- of the request.
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
contentProviderWriteMimeTypeAsync :: a
-> Text
-> b
-> Int32
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
contentProviderWriteMimeTypeAsync provider :: a
provider mimeType :: Text
mimeType stream :: b
stream ioPriority :: Int32
ioPriority cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    Ptr OutputStream
stream' <- b -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr ContentProvider
-> CString
-> Ptr OutputStream
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_content_provider_write_mime_type_async Ptr ContentProvider
provider' CString
mimeType' Ptr OutputStream
stream' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContentProviderWriteMimeTypeAsyncMethodInfo
instance (signature ~ (T.Text -> b -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsContentProvider a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ContentProviderWriteMimeTypeAsyncMethodInfo a signature where
    overloadedMethod = contentProviderWriteMimeTypeAsync

#endif

-- method ContentProvider::write_mime_type_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_content_provider_write_mime_type_finish" gdk_content_provider_write_mime_type_finish :: 
    Ptr ContentProvider ->                  -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous write operation started with
-- 'GI.Gdk.Objects.ContentProvider.contentProviderWriteMimeTypeAsync'.
contentProviderWriteMimeTypeFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsContentProvider a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@provider@/: a t'GI.Gdk.Objects.ContentProvider.ContentProvider'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
contentProviderWriteMimeTypeFinish :: a -> b -> m ()
contentProviderWriteMimeTypeFinish provider :: a
provider result_ :: b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentProvider
provider' <- a -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
provider
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ContentProvider
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
gdk_content_provider_write_mime_type_finish Ptr ContentProvider
provider' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
provider
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ContentProviderWriteMimeTypeFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContentProvider a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ContentProviderWriteMimeTypeFinishMethodInfo a signature where
    overloadedMethod = contentProviderWriteMimeTypeFinish

#endif