{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.OutputStream.OutputStream' has functions to write to a stream ('GI.Gio.Objects.OutputStream.outputStreamWrite'),
-- to close a stream ('GI.Gio.Objects.OutputStream.outputStreamClose') and to flush pending writes
-- ('GI.Gio.Objects.OutputStream.outputStreamFlush').
-- 
-- To copy the content of an input stream to an output stream without
-- manually handling the reads and writes, use 'GI.Gio.Objects.OutputStream.outputStreamSplice'.
-- 
-- See the documentation for t'GI.Gio.Objects.IOStream.IOStream' for details of thread safety of
-- streaming APIs.
-- 
-- All of these functions have async variants too.

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

module GI.Gio.Objects.OutputStream
    ( 

-- * Exported types
    OutputStream(..)                        ,
    IsOutputStream                          ,
    toOutputStream                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearPending]("GI.Gio.Objects.OutputStream#g:method:clearPending"), [close]("GI.Gio.Objects.OutputStream#g:method:close"), [closeAsync]("GI.Gio.Objects.OutputStream#g:method:closeAsync"), [closeFinish]("GI.Gio.Objects.OutputStream#g:method:closeFinish"), [flush]("GI.Gio.Objects.OutputStream#g:method:flush"), [flushAsync]("GI.Gio.Objects.OutputStream#g:method:flushAsync"), [flushFinish]("GI.Gio.Objects.OutputStream#g:method:flushFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasPending]("GI.Gio.Objects.OutputStream#g:method:hasPending"), [isClosed]("GI.Gio.Objects.OutputStream#g:method:isClosed"), [isClosing]("GI.Gio.Objects.OutputStream#g:method:isClosing"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [splice]("GI.Gio.Objects.OutputStream#g:method:splice"), [spliceAsync]("GI.Gio.Objects.OutputStream#g:method:spliceAsync"), [spliceFinish]("GI.Gio.Objects.OutputStream#g:method:spliceFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [write]("GI.Gio.Objects.OutputStream#g:method:write"), [writeAll]("GI.Gio.Objects.OutputStream#g:method:writeAll"), [writeAllAsync]("GI.Gio.Objects.OutputStream#g:method:writeAllAsync"), [writeAllFinish]("GI.Gio.Objects.OutputStream#g:method:writeAllFinish"), [writeAsync]("GI.Gio.Objects.OutputStream#g:method:writeAsync"), [writeBytes]("GI.Gio.Objects.OutputStream#g:method:writeBytes"), [writeBytesAsync]("GI.Gio.Objects.OutputStream#g:method:writeBytesAsync"), [writeBytesFinish]("GI.Gio.Objects.OutputStream#g:method:writeBytesFinish"), [writeFinish]("GI.Gio.Objects.OutputStream#g:method:writeFinish"), [writev]("GI.Gio.Objects.OutputStream#g:method:writev"), [writevAll]("GI.Gio.Objects.OutputStream#g:method:writevAll"), [writevAllAsync]("GI.Gio.Objects.OutputStream#g:method:writevAllAsync"), [writevAllFinish]("GI.Gio.Objects.OutputStream#g:method:writevAllFinish"), [writevAsync]("GI.Gio.Objects.OutputStream#g:method:writevAsync"), [writevFinish]("GI.Gio.Objects.OutputStream#g:method:writevFinish").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPending]("GI.Gio.Objects.OutputStream#g:method:setPending"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveOutputStreamMethod               ,
#endif

-- ** clearPending #method:clearPending#

#if defined(ENABLE_OVERLOADING)
    OutputStreamClearPendingMethodInfo      ,
#endif
    outputStreamClearPending                ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    OutputStreamCloseMethodInfo             ,
#endif
    outputStreamClose                       ,


-- ** closeAsync #method:closeAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamCloseAsyncMethodInfo        ,
#endif
    outputStreamCloseAsync                  ,


-- ** closeFinish #method:closeFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamCloseFinishMethodInfo       ,
#endif
    outputStreamCloseFinish                 ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    OutputStreamFlushMethodInfo             ,
#endif
    outputStreamFlush                       ,


-- ** flushAsync #method:flushAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamFlushAsyncMethodInfo        ,
#endif
    outputStreamFlushAsync                  ,


-- ** flushFinish #method:flushFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamFlushFinishMethodInfo       ,
#endif
    outputStreamFlushFinish                 ,


-- ** hasPending #method:hasPending#

#if defined(ENABLE_OVERLOADING)
    OutputStreamHasPendingMethodInfo        ,
#endif
    outputStreamHasPending                  ,


-- ** isClosed #method:isClosed#

#if defined(ENABLE_OVERLOADING)
    OutputStreamIsClosedMethodInfo          ,
#endif
    outputStreamIsClosed                    ,


-- ** isClosing #method:isClosing#

#if defined(ENABLE_OVERLOADING)
    OutputStreamIsClosingMethodInfo         ,
#endif
    outputStreamIsClosing                   ,


-- ** setPending #method:setPending#

#if defined(ENABLE_OVERLOADING)
    OutputStreamSetPendingMethodInfo        ,
#endif
    outputStreamSetPending                  ,


-- ** splice #method:splice#

#if defined(ENABLE_OVERLOADING)
    OutputStreamSpliceMethodInfo            ,
#endif
    outputStreamSplice                      ,


-- ** spliceAsync #method:spliceAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamSpliceAsyncMethodInfo       ,
#endif
    outputStreamSpliceAsync                 ,


-- ** spliceFinish #method:spliceFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamSpliceFinishMethodInfo      ,
#endif
    outputStreamSpliceFinish                ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteMethodInfo             ,
#endif
    outputStreamWrite                       ,


-- ** writeAll #method:writeAll#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteAllMethodInfo          ,
#endif
    outputStreamWriteAll                    ,


-- ** writeAllAsync #method:writeAllAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteAllAsyncMethodInfo     ,
#endif
    outputStreamWriteAllAsync               ,


-- ** writeAllFinish #method:writeAllFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteAllFinishMethodInfo    ,
#endif
    outputStreamWriteAllFinish              ,


-- ** writeAsync #method:writeAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteAsyncMethodInfo        ,
#endif
    outputStreamWriteAsync                  ,


-- ** writeBytes #method:writeBytes#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteBytesMethodInfo        ,
#endif
    outputStreamWriteBytes                  ,


-- ** writeBytesAsync #method:writeBytesAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteBytesAsyncMethodInfo   ,
#endif
    outputStreamWriteBytesAsync             ,


-- ** writeBytesFinish #method:writeBytesFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteBytesFinishMethodInfo  ,
#endif
    outputStreamWriteBytesFinish            ,


-- ** writeFinish #method:writeFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWriteFinishMethodInfo       ,
#endif
    outputStreamWriteFinish                 ,


-- ** writev #method:writev#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevMethodInfo            ,
#endif
    outputStreamWritev                      ,


-- ** writevAll #method:writevAll#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevAllMethodInfo         ,
#endif
    outputStreamWritevAll                   ,


-- ** writevAllAsync #method:writevAllAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevAllAsyncMethodInfo    ,
#endif
    outputStreamWritevAllAsync              ,


-- ** writevAllFinish #method:writevAllFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevAllFinishMethodInfo   ,
#endif
    outputStreamWritevAllFinish             ,


-- ** writevAsync #method:writevAsync#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevAsyncMethodInfo       ,
#endif
    outputStreamWritevAsync                 ,


-- ** writevFinish #method:writevFinish#

#if defined(ENABLE_OVERLOADING)
    OutputStreamWritevFinishMethodInfo      ,
#endif
    outputStreamWritevFinish                ,




    ) where

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

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

import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Gio.Structs.OutputVector as Gio.OutputVector

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

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

foreign import ccall "g_output_stream_get_type"
    c_g_output_stream_get_type :: IO B.Types.GType

instance B.Types.TypedObject OutputStream where
    glibType :: IO GType
glibType = IO GType
c_g_output_stream_get_type

instance B.Types.GObject OutputStream

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveOutputStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveOutputStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveOutputStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveOutputStreamMethod "clearPending" o = OutputStreamClearPendingMethodInfo
    ResolveOutputStreamMethod "close" o = OutputStreamCloseMethodInfo
    ResolveOutputStreamMethod "closeAsync" o = OutputStreamCloseAsyncMethodInfo
    ResolveOutputStreamMethod "closeFinish" o = OutputStreamCloseFinishMethodInfo
    ResolveOutputStreamMethod "flush" o = OutputStreamFlushMethodInfo
    ResolveOutputStreamMethod "flushAsync" o = OutputStreamFlushAsyncMethodInfo
    ResolveOutputStreamMethod "flushFinish" o = OutputStreamFlushFinishMethodInfo
    ResolveOutputStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveOutputStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveOutputStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveOutputStreamMethod "hasPending" o = OutputStreamHasPendingMethodInfo
    ResolveOutputStreamMethod "isClosed" o = OutputStreamIsClosedMethodInfo
    ResolveOutputStreamMethod "isClosing" o = OutputStreamIsClosingMethodInfo
    ResolveOutputStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveOutputStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveOutputStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveOutputStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveOutputStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveOutputStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveOutputStreamMethod "splice" o = OutputStreamSpliceMethodInfo
    ResolveOutputStreamMethod "spliceAsync" o = OutputStreamSpliceAsyncMethodInfo
    ResolveOutputStreamMethod "spliceFinish" o = OutputStreamSpliceFinishMethodInfo
    ResolveOutputStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveOutputStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveOutputStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveOutputStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveOutputStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveOutputStreamMethod "write" o = OutputStreamWriteMethodInfo
    ResolveOutputStreamMethod "writeAll" o = OutputStreamWriteAllMethodInfo
    ResolveOutputStreamMethod "writeAllAsync" o = OutputStreamWriteAllAsyncMethodInfo
    ResolveOutputStreamMethod "writeAllFinish" o = OutputStreamWriteAllFinishMethodInfo
    ResolveOutputStreamMethod "writeAsync" o = OutputStreamWriteAsyncMethodInfo
    ResolveOutputStreamMethod "writeBytes" o = OutputStreamWriteBytesMethodInfo
    ResolveOutputStreamMethod "writeBytesAsync" o = OutputStreamWriteBytesAsyncMethodInfo
    ResolveOutputStreamMethod "writeBytesFinish" o = OutputStreamWriteBytesFinishMethodInfo
    ResolveOutputStreamMethod "writeFinish" o = OutputStreamWriteFinishMethodInfo
    ResolveOutputStreamMethod "writev" o = OutputStreamWritevMethodInfo
    ResolveOutputStreamMethod "writevAll" o = OutputStreamWritevAllMethodInfo
    ResolveOutputStreamMethod "writevAllAsync" o = OutputStreamWritevAllAsyncMethodInfo
    ResolveOutputStreamMethod "writevAllFinish" o = OutputStreamWritevAllFinishMethodInfo
    ResolveOutputStreamMethod "writevAsync" o = OutputStreamWritevAsyncMethodInfo
    ResolveOutputStreamMethod "writevFinish" o = OutputStreamWritevFinishMethodInfo
    ResolveOutputStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveOutputStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveOutputStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveOutputStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveOutputStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveOutputStreamMethod "setPending" o = OutputStreamSetPendingMethodInfo
    ResolveOutputStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveOutputStreamMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList OutputStream
type instance O.AttributeList OutputStream = OutputStreamAttributeList
type OutputStreamAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method OutputStream::clear_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output stream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_clear_pending" g_output_stream_clear_pending :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    IO ()

-- | Clears the pending flag on /@stream@/.
outputStreamClearPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a) =>
    a
    -- ^ /@stream@/: output stream
    -> m ()
outputStreamClearPending :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsOutputStream a) =>
a -> m ()
outputStreamClearPending a
stream = 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr OutputStream -> IO ()
g_output_stream_clear_pending Ptr OutputStream
stream'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamClearPendingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsOutputStream a) => O.OverloadedMethod OutputStreamClearPendingMethodInfo a signature where
    overloadedMethod = outputStreamClearPending

instance O.OverloadedMethodInfo OutputStreamClearPendingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamClearPending",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamClearPending"
        })


#endif

-- method OutputStream::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream." , 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 cancellable object"
--                 , 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 "g_output_stream_close" g_output_stream_close :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Closes the stream, releasing resources related to it.
-- 
-- Once the stream is closed, all other operations will return 'GI.Gio.Enums.IOErrorEnumClosed'.
-- Closing a stream multiple times will not return an error.
-- 
-- Closing a stream will automatically flush any outstanding buffers in the
-- stream.
-- 
-- Streams will be automatically closed when the last reference
-- is dropped, but you might want to call this function to make sure
-- resources are released as early as possible.
-- 
-- Some streams might keep the backing store of the stream (e.g. a file descriptor)
-- open after the stream is closed. See the documentation for the individual
-- stream for details.
-- 
-- On failure the first error that happened will be reported, but the close
-- operation will finish as much as possible. A stream that failed to
-- close will still return 'GI.Gio.Enums.IOErrorEnumClosed' for all operations. Still, it
-- is important to check and report the error to the user, otherwise
-- there might be a loss of data as all data might not be written.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- Cancelling a close will still leave the stream closed, but there some streams
-- can use a faster close that doesn\'t block to e.g. check errors. On
-- cancellation (as with any error) there is no guarantee that all written
-- data will reach the target.
outputStreamClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamClose :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Maybe b -> m ()
outputStreamClose a
stream Maybe b
cancellable = 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 OutputStream -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_output_stream_close Ptr OutputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 OutputStreamCloseMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamCloseMethodInfo a signature where
    overloadedMethod = outputStreamClose

instance O.OverloadedMethodInfo OutputStreamCloseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamClose"
        })


#endif

-- method OutputStream::close_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream." , 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 io priority of 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 cancellable object"
--                 , 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 = 4
--           , 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 "g_output_stream_close_async" g_output_stream_close_async :: 
    Ptr 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 ()

-- | Requests an asynchronous close of the stream, releasing resources
-- related to it. When the operation is finished /@callback@/ will be
-- called. You can then call 'GI.Gio.Objects.OutputStream.outputStreamCloseFinish' to get
-- the result of the operation.
-- 
-- For behaviour details see 'GI.Gio.Objects.OutputStream.outputStreamClose'.
-- 
-- The asynchronous methods have a default fallback that uses threads
-- to implement asynchronicity, so they are optional for inheriting
-- classes. However, if you override one you must override all.
outputStreamCloseAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> Int32
    -- ^ /@ioPriority@/: the io priority of the request.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
outputStreamCloseAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
outputStreamCloseAsync a
stream Int32
ioPriority Maybe b
cancellable 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_close_async 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
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamCloseAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamCloseAsyncMethodInfo a signature where
    overloadedMethod = outputStreamCloseAsync

instance O.OverloadedMethodInfo OutputStreamCloseAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamCloseAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamCloseAsync"
        })


#endif

-- method OutputStream::close_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 "g_output_stream_close_finish" g_output_stream_close_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Closes an output stream.
outputStreamCloseFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamCloseFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m ()
outputStreamCloseFinish a
stream 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    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 OutputStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_output_stream_close_finish Ptr OutputStream
stream' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        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 OutputStreamCloseFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamCloseFinishMethodInfo a signature where
    overloadedMethod = outputStreamCloseFinish

instance O.OverloadedMethodInfo OutputStreamCloseFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamCloseFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamCloseFinish"
        })


#endif

-- method OutputStream::flush
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 cancellable object"
--                 , 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 "g_output_stream_flush" g_output_stream_flush :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Forces a write of all user-space buffered data for the given
-- /@stream@/. Will block during the operation. Closing the stream will
-- implicitly cause a flush.
-- 
-- This function is optional for inherited classes.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
outputStreamFlush ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamFlush :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Maybe b -> m ()
outputStreamFlush a
stream Maybe b
cancellable = 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 OutputStream -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_output_stream_flush Ptr OutputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 OutputStreamFlushMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamFlushMethodInfo a signature where
    overloadedMethod = outputStreamFlush

instance O.OverloadedMethodInfo OutputStreamFlushMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamFlush",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamFlush"
        })


#endif

-- method OutputStream::flush_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 io priority of 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 "a #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , 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 "g_output_stream_flush_async" g_output_stream_flush_async :: 
    Ptr 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 ()

-- | Forces an asynchronous write of all user-space buffered data for
-- the given /@stream@/.
-- For behaviour details see 'GI.Gio.Objects.OutputStream.outputStreamFlush'.
-- 
-- When the operation is finished /@callback@/ will be
-- called. You can then call 'GI.Gio.Objects.OutputStream.outputStreamFlushFinish' to get the
-- result of the operation.
outputStreamFlushAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> Int32
    -- ^ /@ioPriority@/: the io priority of the request.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
outputStreamFlushAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
outputStreamFlushAsync a
stream Int32
ioPriority Maybe b
cancellable 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_flush_async 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
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamFlushAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamFlushAsyncMethodInfo a signature where
    overloadedMethod = outputStreamFlushAsync

instance O.OverloadedMethodInfo OutputStreamFlushAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamFlushAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamFlushAsync"
        })


#endif

-- method OutputStream::flush_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 "g_output_stream_flush_finish" g_output_stream_flush_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes flushing an output stream.
outputStreamFlushFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a GAsyncResult.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamFlushFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m ()
outputStreamFlushFinish a
stream 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    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 OutputStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_output_stream_flush_finish Ptr OutputStream
stream' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        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 OutputStreamFlushFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamFlushFinishMethodInfo a signature where
    overloadedMethod = outputStreamFlushFinish

instance O.OverloadedMethodInfo OutputStreamFlushFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamFlushFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamFlushFinish"
        })


#endif

-- method OutputStream::has_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_has_pending" g_output_stream_has_pending :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    IO CInt

-- | Checks if an output stream has pending actions.
outputStreamHasPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@stream@/ has pending actions.
outputStreamHasPending :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsOutputStream a) =>
a -> m Bool
outputStreamHasPending a
stream = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CInt
result <- Ptr OutputStream -> IO CInt
g_output_stream_has_pending Ptr OutputStream
stream'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OutputStreamHasPendingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsOutputStream a) => O.OverloadedMethod OutputStreamHasPendingMethodInfo a signature where
    overloadedMethod = outputStreamHasPending

instance O.OverloadedMethodInfo OutputStreamHasPendingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamHasPending",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamHasPending"
        })


#endif

-- method OutputStream::is_closed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_is_closed" g_output_stream_is_closed :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    IO CInt

-- | Checks if an output stream has already been closed.
outputStreamIsClosed ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@stream@/ is closed. 'P.False' otherwise.
outputStreamIsClosed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsOutputStream a) =>
a -> m Bool
outputStreamIsClosed a
stream = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CInt
result <- Ptr OutputStream -> IO CInt
g_output_stream_is_closed Ptr OutputStream
stream'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OutputStreamIsClosedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsOutputStream a) => O.OverloadedMethod OutputStreamIsClosedMethodInfo a signature where
    overloadedMethod = outputStreamIsClosed

instance O.OverloadedMethodInfo OutputStreamIsClosedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamIsClosed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamIsClosed"
        })


#endif

-- method OutputStream::is_closing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_is_closing" g_output_stream_is_closing :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    IO CInt

-- | Checks if an output stream is being closed. This can be
-- used inside e.g. a flush implementation to see if the
-- flush (or other i\/o operation) is called from within
-- the closing operation.
-- 
-- /Since: 2.24/
outputStreamIsClosing ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@stream@/ is being closed. 'P.False' otherwise.
outputStreamIsClosing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsOutputStream a) =>
a -> m Bool
outputStreamIsClosing a
stream = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CInt
result <- Ptr OutputStream -> IO CInt
g_output_stream_is_closing Ptr OutputStream
stream'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OutputStreamIsClosingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsOutputStream a) => O.OverloadedMethod OutputStreamIsClosingMethodInfo a signature where
    overloadedMethod = outputStreamIsClosing

instance O.OverloadedMethodInfo OutputStreamIsClosingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamIsClosing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamIsClosing"
        })


#endif

-- method OutputStream::set_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 "g_output_stream_set_pending" g_output_stream_set_pending :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@stream@/ to have actions pending. If the pending flag is
-- already set or /@stream@/ is closed, it will return 'P.False' and set
-- /@error@/.
outputStreamSetPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamSetPending :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsOutputStream a) =>
a -> m ()
outputStreamSetPending a
stream = 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    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 OutputStream -> Ptr (Ptr GError) -> IO CInt
g_output_stream_set_pending Ptr OutputStream
stream'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        () -> 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 OutputStreamSetPendingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsOutputStream a) => O.OverloadedMethod OutputStreamSetPendingMethodInfo a signature where
    overloadedMethod = outputStreamSetPending

instance O.OverloadedMethodInfo OutputStreamSetPendingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamSetPending",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamSetPending"
        })


#endif

-- method OutputStream::splice
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "OutputStreamSpliceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GOutputStreamSpliceFlags."
--                 , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_splice" g_output_stream_splice :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.InputStream.InputStream ->      -- source : TInterface (Name {namespace = "Gio", name = "InputStream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "OutputStreamSpliceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Splices an input stream into an output stream.
outputStreamSplice ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@source@/: a t'GI.Gio.Objects.InputStream.InputStream'.
    -> [Gio.Flags.OutputStreamSpliceFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.OutputStreamSpliceFlags'.
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ containing the size of the data spliced, or
    --     -1 if an error occurred. Note that if the number of bytes
    --     spliced is greater than @/G_MAXSSIZE/@, then that will be
    --     returned, and there is no way to determine the actual number
    --     of bytes spliced. /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamSplice :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsOutputStream a, IsInputStream b,
 IsCancellable c) =>
a -> b -> [OutputStreamSpliceFlags] -> Maybe c -> m Int64
outputStreamSplice a
stream b
source [OutputStreamSpliceFlags]
flags Maybe c
cancellable = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr InputStream
source' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
source
    let flags' :: CUInt
flags' = [OutputStreamSpliceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [OutputStreamSpliceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just 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'
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream
-> Ptr InputStream
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO Int64
g_output_stream_splice Ptr OutputStream
stream' Ptr InputStream
source' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
source
        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
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamSpliceMethodInfo
instance (signature ~ (b -> [Gio.Flags.OutputStreamSpliceFlags] -> Maybe (c) -> m Int64), MonadIO m, IsOutputStream a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod OutputStreamSpliceMethodInfo a signature where
    overloadedMethod = outputStreamSplice

instance O.OverloadedMethodInfo OutputStreamSpliceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamSplice",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamSplice"
        })


#endif

-- method OutputStream::splice_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "OutputStreamSpliceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GOutputStreamSpliceFlags."
--                 , 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 io priority of 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 "a #GAsyncReadyCallback."
--                 , 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 "user data passed to @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_splice_async" g_output_stream_splice_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.InputStream.InputStream ->      -- source : TInterface (Name {namespace = "Gio", name = "InputStream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "OutputStreamSpliceFlags"})
    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 ()

-- | Splices a stream asynchronously.
-- When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.OutputStream.outputStreamSpliceFinish' to get the
-- result of the operation.
-- 
-- For the synchronous, blocking version of this function, see
-- 'GI.Gio.Objects.OutputStream.outputStreamSplice'.
outputStreamSpliceAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@source@/: a t'GI.Gio.Objects.InputStream.InputStream'.
    -> [Gio.Flags.OutputStreamSpliceFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.OutputStreamSpliceFlags'.
    -> Int32
    -- ^ /@ioPriority@/: the 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@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'.
    -> m ()
outputStreamSpliceAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsOutputStream a, IsInputStream b,
 IsCancellable c) =>
a
-> b
-> [OutputStreamSpliceFlags]
-> Int32
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
outputStreamSpliceAsync a
stream b
source [OutputStreamSpliceFlags]
flags Int32
ioPriority Maybe c
cancellable 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr InputStream
source' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
source
    let flags' :: CUInt
flags' = [OutputStreamSpliceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [OutputStreamSpliceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just 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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr InputStream
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_splice_async Ptr OutputStream
stream' Ptr InputStream
source' CUInt
flags' 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
stream
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
source
    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
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamSpliceAsyncMethodInfo
instance (signature ~ (b -> [Gio.Flags.OutputStreamSpliceFlags] -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod OutputStreamSpliceAsyncMethodInfo a signature where
    overloadedMethod = outputStreamSpliceAsync

instance O.OverloadedMethodInfo OutputStreamSpliceAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamSpliceAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamSpliceAsync"
        })


#endif

-- method OutputStream::splice_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_splice_finish" g_output_stream_splice_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Finishes an asynchronous stream splice operation.
outputStreamSpliceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ of the number of bytes spliced. Note that if the
    --     number of bytes spliced is greater than @/G_MAXSSIZE/@, then that
    --     will be returned, and there is no way to determine the actual
    --     number of bytes spliced. /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamSpliceFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Int64
outputStreamSpliceFinish a
stream b
result_ = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Int64
g_output_stream_splice_finish Ptr OutputStream
stream' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamSpliceFinishMethodInfo
instance (signature ~ (b -> m Int64), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamSpliceFinishMethodInfo a signature where
    overloadedMethod = outputStreamSpliceFinish

instance O.OverloadedMethodInfo OutputStreamSpliceFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamSpliceFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamSpliceFinish"
        })


#endif

-- method OutputStream::write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer containing the data to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to write"
--                 , 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 cancellable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of bytes to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write" g_output_stream_write :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Tries to write /@count@/ bytes from /@buffer@/ into the stream. Will block
-- during the operation.
-- 
-- If count is 0, returns 0 and does nothing. A value of /@count@/
-- larger than @/G_MAXSSIZE/@ will cause a 'GI.Gio.Enums.IOErrorEnumInvalidArgument' error.
-- 
-- On success, the number of bytes written to the stream is returned.
-- It is not an error if this is not the same as the requested size, as it
-- can happen e.g. on a partial I\/O error, or if there is not enough
-- storage in the stream. All writes block until at least one byte
-- is written or an error occurs; 0 is never returned (unless
-- /@count@/ is 0).
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned. If an
-- operation was partially finished when the operation was cancelled the
-- partial result will be returned, without an error.
-- 
-- On error -1 is returned and /@error@/ is set accordingly.
outputStreamWrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> ByteString
    -- ^ /@buffer@/: the buffer containing the data to write.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> m Int64
    -- ^ __Returns:__ Number of bytes written, or -1 on error /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWrite :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> ByteString -> Maybe b -> m Int64
outputStreamWrite a
stream ByteString
buffer Maybe b
cancellable = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buffer
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word8
buffer' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buffer
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream
-> Ptr Word8
-> Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO Int64
g_output_stream_write Ptr OutputStream
stream' Ptr Word8
buffer' Word64
count Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> m Int64), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteMethodInfo a signature where
    overloadedMethod = outputStreamWrite

instance O.OverloadedMethodInfo OutputStreamWriteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWrite",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWrite"
        })


#endif

-- method OutputStream::write_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer containing the data to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that was\n    written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , 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
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of bytes to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write_all" g_output_stream_write_all :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to write /@count@/ bytes from /@buffer@/ into the stream. Will block
-- during the operation.
-- 
-- This function is similar to 'GI.Gio.Objects.OutputStream.outputStreamWrite', except it tries to
-- write as many bytes as requested, only stopping on an error.
-- 
-- On a successful write of /@count@/ bytes, 'P.True' is returned, and /@bytesWritten@/
-- is set to /@count@/.
-- 
-- If there is an error during the operation 'P.False' is returned and /@error@/
-- is set to indicate the error status.
-- 
-- As a special exception to the normal conventions for functions that
-- use t'GError', if this function returns 'P.False' (and sets /@error@/) then
-- /@bytesWritten@/ will be set to the number of bytes that were
-- successfully written before the error was encountered.  This
-- functionality is only available from C.  If you need it from another
-- language then you must write your own loop around
-- 'GI.Gio.Objects.OutputStream.outputStreamWrite'.
outputStreamWriteAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> ByteString
    -- ^ /@buffer@/: the buffer containing the data to write.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWriteAll :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> ByteString -> Maybe b -> m Word64
outputStreamWriteAll a
stream ByteString
buffer Maybe b
cancellable = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buffer
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word8
buffer' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buffer
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr Word8
-> Word64
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_output_stream_write_all Ptr OutputStream
stream' Ptr Word8
buffer' Word64
count Ptr Word64
bytesWritten Ptr Cancellable
maybeCancellable
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteAllMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> m (Word64)), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteAllMethodInfo a signature where
    overloadedMethod = outputStreamWriteAll

instance O.OverloadedMethodInfo OutputStreamWriteAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteAll"
        })


#endif

-- method OutputStream::write_all_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer containing the data to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to write"
--                 , 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 io priority of 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: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of bytes to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_write_all_async" g_output_stream_write_all_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    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 ()

-- | Request an asynchronous write of /@count@/ bytes from /@buffer@/ into
-- the stream. When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.OutputStream.outputStreamWriteAllFinish' to get the result of the
-- operation.
-- 
-- This is the asynchronous version of 'GI.Gio.Objects.OutputStream.outputStreamWriteAll'.
-- 
-- Call 'GI.Gio.Objects.OutputStream.outputStreamWriteAllFinish' to collect the result.
-- 
-- Any outstanding I\/O request with higher priority (lower numerical
-- value) will be executed before an outstanding request with lower
-- priority. Default priority is 'GI.GLib.Constants.PRIORITY_DEFAULT'.
-- 
-- Note that no copy of /@buffer@/ will be made, so it must stay valid
-- until /@callback@/ is called.
-- 
-- /Since: 2.44/
outputStreamWriteAllAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'
    -> ByteString
    -- ^ /@buffer@/: the buffer containing the data to write
    -> Int32
    -- ^ /@ioPriority@/: the io priority of the request
    -> Maybe (b)
    -- ^ /@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 ()
outputStreamWriteAllAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a
-> ByteString
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
outputStreamWriteAllAsync a
stream ByteString
buffer Int32
ioPriority Maybe b
cancellable 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
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buffer
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word8
buffer' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buffer
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr Word8
-> Word64
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_write_all_async Ptr OutputStream
stream' Ptr Word8
buffer' Word64
count 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
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteAllAsyncMethodInfo
instance (signature ~ (ByteString -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteAllAsyncMethodInfo a signature where
    overloadedMethod = outputStreamWriteAllAsync

instance O.OverloadedMethodInfo OutputStreamWriteAllAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteAllAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteAllAsync"
        })


#endif

-- method OutputStream::write_all_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream" , 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
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that was written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write_all_finish" g_output_stream_write_all_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous stream write operation started with
-- 'GI.Gio.Objects.OutputStream.outputStreamWriteAllAsync'.
-- 
-- As a special exception to the normal conventions for functions that
-- use t'GError', if this function returns 'P.False' (and sets /@error@/) then
-- /@bytesWritten@/ will be set to the number of bytes that were
-- successfully written before the error was encountered.  This
-- functionality is only available from C.  If you need it from another
-- language then you must write your own loop around
-- 'GI.Gio.Objects.OutputStream.outputStreamWriteAsync'.
-- 
-- /Since: 2.44/
outputStreamWriteAllFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWriteAllFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Word64
outputStreamWriteAllFinish a
stream b
result_ = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CInt
g_output_stream_write_all_finish Ptr OutputStream
stream' Ptr AsyncResult
result_' Ptr Word64
bytesWritten
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteAllFinishMethodInfo
instance (signature ~ (b -> m (Word64)), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamWriteAllFinishMethodInfo a signature where
    overloadedMethod = outputStreamWriteAllFinish

instance O.OverloadedMethodInfo OutputStreamWriteAllFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteAllFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteAllFinish"
        })


#endif

-- method OutputStream::write_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer containing the data to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to write"
--                 , 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 io priority of 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: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of bytes to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_write_async" g_output_stream_write_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    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 ()

-- | Request an asynchronous write of /@count@/ bytes from /@buffer@/ into
-- the stream. When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.OutputStream.outputStreamWriteFinish' to get the result of the
-- operation.
-- 
-- During an async request no other sync and async calls are allowed,
-- and will result in 'GI.Gio.Enums.IOErrorEnumPending' errors.
-- 
-- A value of /@count@/ larger than @/G_MAXSSIZE/@ will cause a
-- 'GI.Gio.Enums.IOErrorEnumInvalidArgument' error.
-- 
-- On success, the number of bytes written will be passed to the
-- /@callback@/. It is not an error if this is not the same as the
-- requested size, as it can happen e.g. on a partial I\/O error,
-- but generally we try to write as many bytes as requested.
-- 
-- You are guaranteed that this method will never fail with
-- 'GI.Gio.Enums.IOErrorEnumWouldBlock' - if /@stream@/ can\'t accept more data, the
-- method will just wait until this changes.
-- 
-- Any outstanding I\/O request with higher priority (lower numerical
-- value) will be executed before an outstanding request with lower
-- priority. Default priority is 'GI.GLib.Constants.PRIORITY_DEFAULT'.
-- 
-- The asynchronous methods have a default fallback that uses threads
-- to implement asynchronicity, so they are optional for inheriting
-- classes. However, if you override one you must override all.
-- 
-- For the synchronous, blocking version of this function, see
-- 'GI.Gio.Objects.OutputStream.outputStreamWrite'.
-- 
-- Note that no copy of /@buffer@/ will be made, so it must stay valid
-- until /@callback@/ is called. See 'GI.Gio.Objects.OutputStream.outputStreamWriteBytesAsync'
-- for a t'GI.GLib.Structs.Bytes.Bytes' version that will automatically hold a reference to
-- the contents (without copying) for the duration of the call.
outputStreamWriteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> Maybe (ByteString)
    -- ^ /@buffer@/: the buffer containing the data to write.
    -> Int32
    -- ^ /@ioPriority@/: the io priority of the request.
    -> Maybe (b)
    -- ^ /@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 ()
outputStreamWriteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a
-> Maybe ByteString
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
outputStreamWriteAsync a
stream Maybe ByteString
buffer Int32
ioPriority Maybe b
cancellable 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
    let count :: Word64
count = case Maybe ByteString
buffer of
            Maybe ByteString
Nothing -> Word64
0
            Just ByteString
jBuffer -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
jBuffer
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word8
maybeBuffer <- case Maybe ByteString
buffer of
        Maybe ByteString
Nothing -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
forall a. Ptr a
nullPtr
        Just ByteString
jBuffer -> do
            Ptr Word8
jBuffer' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
jBuffer
            Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
jBuffer'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr Word8
-> Word64
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_write_async Ptr OutputStream
stream' Ptr Word8
maybeBuffer Word64
count 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
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
maybeBuffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteAsyncMethodInfo
instance (signature ~ (Maybe (ByteString) -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteAsyncMethodInfo a signature where
    overloadedMethod = outputStreamWriteAsync

instance O.OverloadedMethodInfo OutputStreamWriteAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteAsync"
        })


#endif

-- method OutputStream::write_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 "the #GBytes to write"
--                 , 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 cancellable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write_bytes" g_output_stream_write_bytes :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | A wrapper function for 'GI.Gio.Objects.OutputStream.outputStreamWrite' which takes a
-- t'GI.GLib.Structs.Bytes.Bytes' as input.  This can be more convenient for use by language
-- bindings or in other cases where the refcounted nature of t'GI.GLib.Structs.Bytes.Bytes'
-- is helpful over a bare pointer interface.
-- 
-- However, note that this function may still perform partial writes,
-- just like 'GI.Gio.Objects.OutputStream.outputStreamWrite'.  If that occurs, to continue
-- writing, you will need to create a new t'GI.GLib.Structs.Bytes.Bytes' containing just the
-- remaining bytes, using 'GI.GLib.Structs.Bytes.bytesNewFromBytes'. Passing the same
-- t'GI.GLib.Structs.Bytes.Bytes' instance multiple times potentially can result in duplicated
-- data in the output stream.
outputStreamWriteBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> GLib.Bytes.Bytes
    -- ^ /@bytes@/: the t'GI.GLib.Structs.Bytes.Bytes' to write
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> m Int64
    -- ^ __Returns:__ Number of bytes written, or -1 on error /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWriteBytes :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Bytes -> Maybe b -> m Int64
outputStreamWriteBytes a
stream Bytes
bytes Maybe b
cancellable = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream
-> Ptr Bytes -> Ptr Cancellable -> Ptr (Ptr GError) -> IO Int64
g_output_stream_write_bytes Ptr OutputStream
stream' Ptr Bytes
bytes' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteBytesMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> Maybe (b) -> m Int64), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteBytesMethodInfo a signature where
    overloadedMethod = outputStreamWriteBytes

instance O.OverloadedMethodInfo OutputStreamWriteBytesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteBytes"
        })


#endif

-- method OutputStream::write_bytes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream." , 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 "The bytes to write" , 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 io priority of 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 = 5
--           , 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 "g_output_stream_write_bytes_async" g_output_stream_write_bytes_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    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 ()

-- | This function is similar to 'GI.Gio.Objects.OutputStream.outputStreamWriteAsync', but
-- takes a t'GI.GLib.Structs.Bytes.Bytes' as input.  Due to the refcounted nature of t'GI.GLib.Structs.Bytes.Bytes',
-- this allows the stream to avoid taking a copy of the data.
-- 
-- However, note that this function may still perform partial writes,
-- just like 'GI.Gio.Objects.OutputStream.outputStreamWriteAsync'. If that occurs, to continue
-- writing, you will need to create a new t'GI.GLib.Structs.Bytes.Bytes' containing just the
-- remaining bytes, using 'GI.GLib.Structs.Bytes.bytesNewFromBytes'. Passing the same
-- t'GI.GLib.Structs.Bytes.Bytes' instance multiple times potentially can result in duplicated
-- data in the output stream.
-- 
-- For the synchronous, blocking version of this function, see
-- 'GI.Gio.Objects.OutputStream.outputStreamWriteBytes'.
outputStreamWriteBytesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> GLib.Bytes.Bytes
    -- ^ /@bytes@/: The bytes to write
    -> Int32
    -- ^ /@ioPriority@/: the io priority of the request.
    -> Maybe (b)
    -- ^ /@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 ()
outputStreamWriteBytesAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> Bytes -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
outputStreamWriteBytesAsync a
stream Bytes
bytes Int32
ioPriority Maybe b
cancellable 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 OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr Bytes
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_write_bytes_async Ptr OutputStream
stream' Ptr Bytes
bytes' 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
stream
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteBytesAsyncMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWriteBytesAsyncMethodInfo a signature where
    overloadedMethod = outputStreamWriteBytesAsync

instance O.OverloadedMethodInfo OutputStreamWriteBytesAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteBytesAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteBytesAsync"
        })


#endif

-- method OutputStream::write_bytes_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write_bytes_finish" g_output_stream_write_bytes_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Finishes a stream write-from-t'GI.GLib.Structs.Bytes.Bytes' operation.
outputStreamWriteBytesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ containing the number of bytes written to the stream. /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWriteBytesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Int64
outputStreamWriteBytesFinish a
stream b
result_ = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Int64
g_output_stream_write_bytes_finish Ptr OutputStream
stream' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteBytesFinishMethodInfo
instance (signature ~ (b -> m Int64), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamWriteBytesFinishMethodInfo a signature where
    overloadedMethod = outputStreamWriteBytesFinish

instance O.OverloadedMethodInfo OutputStreamWriteBytesFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteBytesFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteBytesFinish"
        })


#endif

-- method OutputStream::write_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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 TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_write_finish" g_output_stream_write_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Finishes a stream write operation.
outputStreamWriteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ containing the number of bytes written to the stream. /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWriteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Int64
outputStreamWriteFinish a
stream b
result_ = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr OutputStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Int64
g_output_stream_write_finish Ptr OutputStream
stream' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWriteFinishMethodInfo
instance (signature ~ (b -> m Int64), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamWriteFinishMethodInfo a signature where
    overloadedMethod = outputStreamWriteFinish

instance O.OverloadedMethodInfo OutputStreamWriteFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWriteFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWriteFinish"
        })


#endif

-- method OutputStream::writev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vectors"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gio" , name = "OutputVector" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the buffer containing the #GOutputVectors to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_vectors"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of vectors to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that were\n    written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional cancellable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_vectors"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of vectors to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_writev" g_output_stream_writev :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.OutputVector.OutputVector ->    -- vectors : TCArray False (-1) 2 (TInterface (Name {namespace = "Gio", name = "OutputVector"}))
    Word64 ->                               -- n_vectors : TBasicType TUInt64
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to write the bytes contained in the /@nVectors@/ /@vectors@/ into the
-- stream. Will block during the operation.
-- 
-- If /@nVectors@/ is 0 or the sum of all bytes in /@vectors@/ is 0, returns 0 and
-- does nothing.
-- 
-- On success, the number of bytes written to the stream is returned.
-- It is not an error if this is not the same as the requested size, as it
-- can happen e.g. on a partial I\/O error, or if there is not enough
-- storage in the stream. All writes block until at least one byte
-- is written or an error occurs; 0 is never returned (unless
-- /@nVectors@/ is 0 or the sum of all bytes in /@vectors@/ is 0).
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned. If an
-- operation was partially finished when the operation was cancelled the
-- partial result will be returned, without an error.
-- 
-- Some implementations of 'GI.Gio.Objects.OutputStream.outputStreamWritev' may have limitations on the
-- aggregate buffer size, and will return 'GI.Gio.Enums.IOErrorEnumInvalidArgument' if these
-- are exceeded. For example, when writing to a local file on UNIX platforms,
-- the aggregate buffer size must not exceed @/G_MAXSSIZE/@ bytes.
-- 
-- /Since: 2.60/
outputStreamWritev ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> [Gio.OutputVector.OutputVector]
    -- ^ /@vectors@/: the buffer containing the @/GOutputVectors/@ to write.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellable object
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWritev :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> [OutputVector] -> Maybe b -> m Word64
outputStreamWritev a
stream [OutputVector]
vectors Maybe b
cancellable = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    let nVectors :: Word64
nVectors = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [OutputVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [OutputVector]
vectors
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    [Ptr OutputVector]
vectors' <- (OutputVector -> IO (Ptr OutputVector))
-> [OutputVector] -> IO [Ptr OutputVector]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutputVector -> IO (Ptr OutputVector)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [OutputVector]
vectors
    Ptr OutputVector
vectors'' <- Int -> [Ptr OutputVector] -> IO (Ptr OutputVector)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr OutputVector]
vectors'
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr OutputVector
-> Word64
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_output_stream_writev Ptr OutputStream
stream' Ptr OutputVector
vectors'' Word64
nVectors Ptr Word64
bytesWritten Ptr Cancellable
maybeCancellable
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        (OutputVector -> IO ()) -> [OutputVector] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OutputVector -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [OutputVector]
vectors
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevMethodInfo
instance (signature ~ ([Gio.OutputVector.OutputVector] -> Maybe (b) -> m (Word64)), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWritevMethodInfo a signature where
    overloadedMethod = outputStreamWritev

instance O.OverloadedMethodInfo OutputStreamWritevMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritev",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritev"
        })


#endif

-- method OutputStream::writev_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vectors"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gio" , name = "OutputVector" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the buffer containing the #GOutputVectors to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_vectors"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of vectors to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that were\n    written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , 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
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_vectors"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of vectors to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_writev_all" g_output_stream_writev_all :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.OutputVector.OutputVector ->    -- vectors : TCArray False (-1) 2 (TInterface (Name {namespace = "Gio", name = "OutputVector"}))
    Word64 ->                               -- n_vectors : TBasicType TUInt64
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to write the bytes contained in the /@nVectors@/ /@vectors@/ into the
-- stream. Will block during the operation.
-- 
-- This function is similar to 'GI.Gio.Objects.OutputStream.outputStreamWritev', except it tries to
-- write as many bytes as requested, only stopping on an error.
-- 
-- On a successful write of all /@nVectors@/ vectors, 'P.True' is returned, and
-- /@bytesWritten@/ is set to the sum of all the sizes of /@vectors@/.
-- 
-- If there is an error during the operation 'P.False' is returned and /@error@/
-- is set to indicate the error status.
-- 
-- As a special exception to the normal conventions for functions that
-- use t'GError', if this function returns 'P.False' (and sets /@error@/) then
-- /@bytesWritten@/ will be set to the number of bytes that were
-- successfully written before the error was encountered.  This
-- functionality is only available from C. If you need it from another
-- language then you must write your own loop around
-- 'GI.Gio.Objects.OutputStream.outputStreamWrite'.
-- 
-- The content of the individual elements of /@vectors@/ might be changed by this
-- function.
-- 
-- /Since: 2.60/
outputStreamWritevAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> [Gio.OutputVector.OutputVector]
    -- ^ /@vectors@/: the buffer containing the @/GOutputVectors/@ to write.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWritevAll :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a -> [OutputVector] -> Maybe b -> m Word64
outputStreamWritevAll a
stream [OutputVector]
vectors Maybe b
cancellable = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    let nVectors :: Word64
nVectors = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [OutputVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [OutputVector]
vectors
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    [Ptr OutputVector]
vectors' <- (OutputVector -> IO (Ptr OutputVector))
-> [OutputVector] -> IO [Ptr OutputVector]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutputVector -> IO (Ptr OutputVector)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [OutputVector]
vectors
    Ptr OutputVector
vectors'' <- Int -> [Ptr OutputVector] -> IO (Ptr OutputVector)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr OutputVector]
vectors'
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr OutputVector
-> Word64
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_output_stream_writev_all Ptr OutputStream
stream' Ptr OutputVector
vectors'' Word64
nVectors Ptr Word64
bytesWritten Ptr Cancellable
maybeCancellable
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        (OutputVector -> IO ()) -> [OutputVector] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OutputVector -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [OutputVector]
vectors
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevAllMethodInfo
instance (signature ~ ([Gio.OutputVector.OutputVector] -> Maybe (b) -> m (Word64)), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWritevAllMethodInfo a signature where
    overloadedMethod = outputStreamWritevAll

instance O.OverloadedMethodInfo OutputStreamWritevAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritevAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritevAll"
        })


#endif

-- method OutputStream::writev_all_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vectors"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gio" , name = "OutputVector" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the buffer containing the #GOutputVectors to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_vectors"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of vectors to write"
--                 , 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 of 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: [ Arg
--              { argCName = "n_vectors"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of vectors to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_writev_all_async" g_output_stream_writev_all_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.OutputVector.OutputVector ->    -- vectors : TCArray False (-1) 2 (TInterface (Name {namespace = "Gio", name = "OutputVector"}))
    Word64 ->                               -- n_vectors : TBasicType TUInt64
    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 ()

-- | Request an asynchronous write of the bytes contained in the /@nVectors@/ /@vectors@/ into
-- the stream. When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.OutputStream.outputStreamWritevAllFinish' to get the result of the
-- operation.
-- 
-- This is the asynchronous version of 'GI.Gio.Objects.OutputStream.outputStreamWritevAll'.
-- 
-- Call 'GI.Gio.Objects.OutputStream.outputStreamWritevAllFinish' to collect the result.
-- 
-- Any outstanding I\/O request with higher priority (lower numerical
-- value) will be executed before an outstanding request with lower
-- priority. Default priority is 'GI.GLib.Constants.PRIORITY_DEFAULT'.
-- 
-- Note that no copy of /@vectors@/ will be made, so it must stay valid
-- until /@callback@/ is called. The content of the individual elements
-- of /@vectors@/ might be changed by this function.
-- 
-- /Since: 2.60/
outputStreamWritevAllAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'
    -> [Gio.OutputVector.OutputVector]
    -- ^ /@vectors@/: the buffer containing the @/GOutputVectors/@ to write.
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (b)
    -- ^ /@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 ()
outputStreamWritevAllAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a
-> [OutputVector]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
outputStreamWritevAllAsync a
stream [OutputVector]
vectors Int32
ioPriority Maybe b
cancellable 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
    let nVectors :: Word64
nVectors = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [OutputVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [OutputVector]
vectors
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    [Ptr OutputVector]
vectors' <- (OutputVector -> IO (Ptr OutputVector))
-> [OutputVector] -> IO [Ptr OutputVector]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutputVector -> IO (Ptr OutputVector)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [OutputVector]
vectors
    Ptr OutputVector
vectors'' <- Int -> [Ptr OutputVector] -> IO (Ptr OutputVector)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr OutputVector]
vectors'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr OutputVector
-> Word64
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_writev_all_async Ptr OutputStream
stream' Ptr OutputVector
vectors'' Word64
nVectors 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
stream
    (OutputVector -> IO ()) -> [OutputVector] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OutputVector -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [OutputVector]
vectors
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevAllAsyncMethodInfo
instance (signature ~ ([Gio.OutputVector.OutputVector] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWritevAllAsyncMethodInfo a signature where
    overloadedMethod = outputStreamWritevAllAsync

instance O.OverloadedMethodInfo OutputStreamWritevAllAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritevAllAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritevAllAsync"
        })


#endif

-- method OutputStream::writev_all_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream" , 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
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that were written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_writev_all_finish" g_output_stream_writev_all_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous stream write operation started with
-- 'GI.Gio.Objects.OutputStream.outputStreamWritevAllAsync'.
-- 
-- As a special exception to the normal conventions for functions that
-- use t'GError', if this function returns 'P.False' (and sets /@error@/) then
-- /@bytesWritten@/ will be set to the number of bytes that were
-- successfully written before the error was encountered.  This
-- functionality is only available from C.  If you need it from another
-- language then you must write your own loop around
-- 'GI.Gio.Objects.OutputStream.outputStreamWritevAsync'.
-- 
-- /Since: 2.60/
outputStreamWritevAllFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWritevAllFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Word64
outputStreamWritevAllFinish a
stream b
result_ = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CInt
g_output_stream_writev_all_finish Ptr OutputStream
stream' Ptr AsyncResult
result_' Ptr Word64
bytesWritten
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevAllFinishMethodInfo
instance (signature ~ (b -> m (Word64)), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamWritevAllFinishMethodInfo a signature where
    overloadedMethod = outputStreamWritevAllFinish

instance O.OverloadedMethodInfo OutputStreamWritevAllFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritevAllFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritevAllFinish"
        })


#endif

-- method OutputStream::writev_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GOutputStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vectors"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gio" , name = "OutputVector" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the buffer containing the #GOutputVectors to write."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_vectors"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of vectors to write"
--                 , 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 of 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: [ Arg
--              { argCName = "n_vectors"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of vectors to write"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_output_stream_writev_async" g_output_stream_writev_async :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.OutputVector.OutputVector ->    -- vectors : TCArray False (-1) 2 (TInterface (Name {namespace = "Gio", name = "OutputVector"}))
    Word64 ->                               -- n_vectors : TBasicType TUInt64
    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 ()

-- | Request an asynchronous write of the bytes contained in /@nVectors@/ /@vectors@/ into
-- the stream. When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.OutputStream.outputStreamWritevFinish' to get the result of the
-- operation.
-- 
-- During an async request no other sync and async calls are allowed,
-- and will result in 'GI.Gio.Enums.IOErrorEnumPending' errors.
-- 
-- On success, the number of bytes written will be passed to the
-- /@callback@/. It is not an error if this is not the same as the
-- requested size, as it can happen e.g. on a partial I\/O error,
-- but generally we try to write as many bytes as requested.
-- 
-- You are guaranteed that this method will never fail with
-- 'GI.Gio.Enums.IOErrorEnumWouldBlock' — if /@stream@/ can\'t accept more data, the
-- method will just wait until this changes.
-- 
-- Any outstanding I\/O request with higher priority (lower numerical
-- value) will be executed before an outstanding request with lower
-- priority. Default priority is 'GI.GLib.Constants.PRIORITY_DEFAULT'.
-- 
-- The asynchronous methods have a default fallback that uses threads
-- to implement asynchronicity, so they are optional for inheriting
-- classes. However, if you override one you must override all.
-- 
-- For the synchronous, blocking version of this function, see
-- 'GI.Gio.Objects.OutputStream.outputStreamWritev'.
-- 
-- Note that no copy of /@vectors@/ will be made, so it must stay valid
-- until /@callback@/ is called.
-- 
-- /Since: 2.60/
outputStreamWritevAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: A t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> [Gio.OutputVector.OutputVector]
    -- ^ /@vectors@/: the buffer containing the @/GOutputVectors/@ to write.
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request.
    -> Maybe (b)
    -- ^ /@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 ()
outputStreamWritevAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a
-> [OutputVector]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
outputStreamWritevAsync a
stream [OutputVector]
vectors Int32
ioPriority Maybe b
cancellable 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
    let nVectors :: Word64
nVectors = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [OutputVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [OutputVector]
vectors
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    [Ptr OutputVector]
vectors' <- (OutputVector -> IO (Ptr OutputVector))
-> [OutputVector] -> IO [Ptr OutputVector]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutputVector -> IO (Ptr OutputVector)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [OutputVector]
vectors
    Ptr OutputVector
vectors'' <- Int -> [Ptr OutputVector] -> IO (Ptr OutputVector)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr OutputVector]
vectors'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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
        Maybe AsyncReadyCallback
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 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 OutputStream
-> Ptr OutputVector
-> Word64
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_output_stream_writev_async Ptr OutputStream
stream' Ptr OutputVector
vectors'' Word64
nVectors 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
stream
    (OutputVector -> IO ()) -> [OutputVector] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OutputVector -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [OutputVector]
vectors
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr OutputVector -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OutputVector
vectors''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevAsyncMethodInfo
instance (signature ~ ([Gio.OutputVector.OutputVector] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsOutputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod OutputStreamWritevAsyncMethodInfo a signature where
    overloadedMethod = outputStreamWritevAsync

instance O.OverloadedMethodInfo OutputStreamWritevAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritevAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritevAsync"
        })


#endif

-- method OutputStream::writev_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream." , 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
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of bytes that were written to the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_output_stream_writev_finish" g_output_stream_writev_finish :: 
    Ptr OutputStream ->                     -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a stream writev operation.
-- 
-- /Since: 2.60/
outputStreamWritevFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
outputStreamWritevFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsAsyncResult b) =>
a -> b -> m Word64
outputStreamWritevFinish a
stream b
result_ = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO Word64 -> IO () -> IO Word64
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 OutputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CInt
g_output_stream_writev_finish Ptr OutputStream
stream' Ptr AsyncResult
result_' Ptr Word64
bytesWritten
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
bytesWritten'
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data OutputStreamWritevFinishMethodInfo
instance (signature ~ (b -> m (Word64)), MonadIO m, IsOutputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod OutputStreamWritevFinishMethodInfo a signature where
    overloadedMethod = outputStreamWritevFinish

instance O.OverloadedMethodInfo OutputStreamWritevFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.OutputStream.outputStreamWritevFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-OutputStream.html#v:outputStreamWritevFinish"
        })


#endif