{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GIOStream represents an object that has both read and write streams.
-- Generally the two streams act as separate input and output streams,
-- but they share some common resources and state. For instance, for
-- seekable streams, both streams may use the same position.
-- 
-- Examples of t'GI.Gio.Objects.IOStream.IOStream' objects are t'GI.Gio.Objects.SocketConnection.SocketConnection', which represents
-- a two-way network connection; and t'GI.Gio.Objects.FileIOStream.FileIOStream', which represents a
-- file handle opened in read-write mode.
-- 
-- To do the actual reading and writing you need to get the substreams
-- with 'GI.Gio.Objects.IOStream.iOStreamGetInputStream' and 'GI.Gio.Objects.IOStream.iOStreamGetOutputStream'.
-- 
-- The t'GI.Gio.Objects.IOStream.IOStream' object owns the input and the output streams, not the other
-- way around, so keeping the substreams alive will not keep the t'GI.Gio.Objects.IOStream.IOStream'
-- object alive. If the t'GI.Gio.Objects.IOStream.IOStream' object is freed it will be closed, thus
-- closing the substreams, so even if the substreams stay alive they will
-- always return 'GI.Gio.Enums.IOErrorEnumClosed' for all operations.
-- 
-- To close a stream use 'GI.Gio.Objects.IOStream.iOStreamClose' which will close the common
-- stream object and also the individual substreams. You can also close
-- the substreams themselves. In most cases this only marks the
-- substream as closed, so further I\/O on it fails but common state in the
-- t'GI.Gio.Objects.IOStream.IOStream' may still be open. However, some streams may support
-- \"half-closed\" states where one direction of the stream is actually shut down.
-- 
-- Operations on @/GIOStreams/@ cannot be started while another operation on the
-- t'GI.Gio.Objects.IOStream.IOStream' or its substreams is in progress. Specifically, an application can
-- read from the t'GI.Gio.Objects.InputStream.InputStream' and write to the t'GI.Gio.Objects.OutputStream.OutputStream' simultaneously
-- (either in separate threads, or as asynchronous operations in the same
-- thread), but an application cannot start any t'GI.Gio.Objects.IOStream.IOStream' operation while there
-- is a t'GI.Gio.Objects.IOStream.IOStream', t'GI.Gio.Objects.InputStream.InputStream' or t'GI.Gio.Objects.OutputStream.OutputStream' operation in progress, and
-- an application can’t start any t'GI.Gio.Objects.InputStream.InputStream' or t'GI.Gio.Objects.OutputStream.OutputStream' operation
-- while there is a t'GI.Gio.Objects.IOStream.IOStream' operation in progress.
-- 
-- This is a product of individual stream operations being associated with a
-- given t'GI.GLib.Structs.MainContext.MainContext' (the thread-default context at the time the operation was
-- started), rather than entire streams being associated with a single
-- t'GI.GLib.Structs.MainContext.MainContext'.
-- 
-- GIO may run operations on @/GIOStreams/@ from other (worker) threads, and this
-- may be exposed to application code in the behaviour of wrapper streams, such
-- as t'GI.Gio.Objects.BufferedInputStream.BufferedInputStream' or t'GI.Gio.Objects.TlsConnection.TlsConnection'. With such wrapper APIs,
-- application code may only run operations on the base (wrapped) stream when
-- the wrapper stream is idle. Note that the semantics of such operations may
-- not be well-defined due to the state the wrapper stream leaves the base
-- stream in (though they are guaranteed not to crash).
-- 
-- /Since: 2.22/

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

module GI.Gio.Objects.IOStream
    ( 

-- * Exported types
    IOStream(..)                            ,
    IsIOStream                              ,
    toIOStream                              ,
    noIOStream                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveIOStreamMethod                   ,
#endif


-- ** clearPending #method:clearPending#

#if defined(ENABLE_OVERLOADING)
    IOStreamClearPendingMethodInfo          ,
#endif
    iOStreamClearPending                    ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    IOStreamCloseMethodInfo                 ,
#endif
    iOStreamClose                           ,


-- ** closeAsync #method:closeAsync#

#if defined(ENABLE_OVERLOADING)
    IOStreamCloseAsyncMethodInfo            ,
#endif
    iOStreamCloseAsync                      ,


-- ** closeFinish #method:closeFinish#

#if defined(ENABLE_OVERLOADING)
    IOStreamCloseFinishMethodInfo           ,
#endif
    iOStreamCloseFinish                     ,


-- ** getInputStream #method:getInputStream#

#if defined(ENABLE_OVERLOADING)
    IOStreamGetInputStreamMethodInfo        ,
#endif
    iOStreamGetInputStream                  ,


-- ** getOutputStream #method:getOutputStream#

#if defined(ENABLE_OVERLOADING)
    IOStreamGetOutputStreamMethodInfo       ,
#endif
    iOStreamGetOutputStream                 ,


-- ** hasPending #method:hasPending#

#if defined(ENABLE_OVERLOADING)
    IOStreamHasPendingMethodInfo            ,
#endif
    iOStreamHasPending                      ,


-- ** isClosed #method:isClosed#

#if defined(ENABLE_OVERLOADING)
    IOStreamIsClosedMethodInfo              ,
#endif
    iOStreamIsClosed                        ,


-- ** setPending #method:setPending#

#if defined(ENABLE_OVERLOADING)
    IOStreamSetPendingMethodInfo            ,
#endif
    iOStreamSetPending                      ,


-- ** spliceAsync #method:spliceAsync#

#if defined(ENABLE_OVERLOADING)
    IOStreamSpliceAsyncMethodInfo           ,
#endif
    iOStreamSpliceAsync                     ,


-- ** spliceFinish #method:spliceFinish#

    iOStreamSpliceFinish                    ,




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

#if defined(ENABLE_OVERLOADING)
    IOStreamClosedPropertyInfo              ,
#endif
    getIOStreamClosed                       ,
#if defined(ENABLE_OVERLOADING)
    iOStreamClosed                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    IOStreamInputStreamPropertyInfo         ,
#endif
    getIOStreamInputStream                  ,
#if defined(ENABLE_OVERLOADING)
    iOStreamInputStream                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    IOStreamOutputStreamPropertyInfo        ,
#endif
    getIOStreamOutputStream                 ,
#if defined(ENABLE_OVERLOADING)
    iOStreamOutputStream                    ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.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.Objects.OutputStream as Gio.OutputStream

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

instance GObject IOStream where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_io_stream_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `IOStream`.
noIOStream :: Maybe IOStream
noIOStream :: Maybe IOStream
noIOStream = Maybe IOStream
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveIOStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveIOStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIOStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIOStreamMethod "clearPending" o = IOStreamClearPendingMethodInfo
    ResolveIOStreamMethod "close" o = IOStreamCloseMethodInfo
    ResolveIOStreamMethod "closeAsync" o = IOStreamCloseAsyncMethodInfo
    ResolveIOStreamMethod "closeFinish" o = IOStreamCloseFinishMethodInfo
    ResolveIOStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIOStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIOStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIOStreamMethod "hasPending" o = IOStreamHasPendingMethodInfo
    ResolveIOStreamMethod "isClosed" o = IOStreamIsClosedMethodInfo
    ResolveIOStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIOStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIOStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIOStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIOStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIOStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIOStreamMethod "spliceAsync" o = IOStreamSpliceAsyncMethodInfo
    ResolveIOStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIOStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIOStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIOStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIOStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIOStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIOStreamMethod "getInputStream" o = IOStreamGetInputStreamMethodInfo
    ResolveIOStreamMethod "getOutputStream" o = IOStreamGetOutputStreamMethodInfo
    ResolveIOStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIOStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIOStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIOStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIOStreamMethod "setPending" o = IOStreamSetPendingMethodInfo
    ResolveIOStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIOStreamMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | Get the value of the “@closed@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iOStream #closed
-- @
getIOStreamClosed :: (MonadIO m, IsIOStream o) => o -> m Bool
getIOStreamClosed :: o -> m Bool
getIOStreamClosed obj :: o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "closed"

#if defined(ENABLE_OVERLOADING)
data IOStreamClosedPropertyInfo
instance AttrInfo IOStreamClosedPropertyInfo where
    type AttrAllowedOps IOStreamClosedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint IOStreamClosedPropertyInfo = IsIOStream
    type AttrSetTypeConstraint IOStreamClosedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint IOStreamClosedPropertyInfo = (~) ()
    type AttrTransferType IOStreamClosedPropertyInfo = ()
    type AttrGetType IOStreamClosedPropertyInfo = Bool
    type AttrLabel IOStreamClosedPropertyInfo = "closed"
    type AttrOrigin IOStreamClosedPropertyInfo = IOStream
    attrGet = getIOStreamClosed
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "input-stream"
   -- Type: TInterface (Name {namespace = "Gio", name = "InputStream"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@input-stream@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iOStream #inputStream
-- @
getIOStreamInputStream :: (MonadIO m, IsIOStream o) => o -> m Gio.InputStream.InputStream
getIOStreamInputStream :: o -> m InputStream
getIOStreamInputStream obj :: o
obj = IO InputStream -> m InputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe InputStream) -> IO InputStream
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getIOStreamInputStream" (IO (Maybe InputStream) -> IO InputStream)
-> IO (Maybe InputStream) -> IO InputStream
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr InputStream -> InputStream)
-> IO (Maybe InputStream)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "input-stream" ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream

#if defined(ENABLE_OVERLOADING)
data IOStreamInputStreamPropertyInfo
instance AttrInfo IOStreamInputStreamPropertyInfo where
    type AttrAllowedOps IOStreamInputStreamPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IOStreamInputStreamPropertyInfo = IsIOStream
    type AttrSetTypeConstraint IOStreamInputStreamPropertyInfo = (~) ()
    type AttrTransferTypeConstraint IOStreamInputStreamPropertyInfo = (~) ()
    type AttrTransferType IOStreamInputStreamPropertyInfo = ()
    type AttrGetType IOStreamInputStreamPropertyInfo = Gio.InputStream.InputStream
    type AttrLabel IOStreamInputStreamPropertyInfo = "input-stream"
    type AttrOrigin IOStreamInputStreamPropertyInfo = IOStream
    attrGet = getIOStreamInputStream
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "output-stream"
   -- Type: TInterface (Name {namespace = "Gio", name = "OutputStream"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@output-stream@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iOStream #outputStream
-- @
getIOStreamOutputStream :: (MonadIO m, IsIOStream o) => o -> m Gio.OutputStream.OutputStream
getIOStreamOutputStream :: o -> m OutputStream
getIOStreamOutputStream obj :: o
obj = IO OutputStream -> m OutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OutputStream -> m OutputStream)
-> IO OutputStream -> m OutputStream
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe OutputStream) -> IO OutputStream
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getIOStreamOutputStream" (IO (Maybe OutputStream) -> IO OutputStream)
-> IO (Maybe OutputStream) -> IO OutputStream
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr OutputStream -> OutputStream)
-> IO (Maybe OutputStream)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "output-stream" ManagedPtr OutputStream -> OutputStream
Gio.OutputStream.OutputStream

#if defined(ENABLE_OVERLOADING)
data IOStreamOutputStreamPropertyInfo
instance AttrInfo IOStreamOutputStreamPropertyInfo where
    type AttrAllowedOps IOStreamOutputStreamPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IOStreamOutputStreamPropertyInfo = IsIOStream
    type AttrSetTypeConstraint IOStreamOutputStreamPropertyInfo = (~) ()
    type AttrTransferTypeConstraint IOStreamOutputStreamPropertyInfo = (~) ()
    type AttrTransferType IOStreamOutputStreamPropertyInfo = ()
    type AttrGetType IOStreamOutputStreamPropertyInfo = Gio.OutputStream.OutputStream
    type AttrLabel IOStreamOutputStreamPropertyInfo = "output-stream"
    type AttrOrigin IOStreamOutputStreamPropertyInfo = IOStream
    attrGet = getIOStreamOutputStream
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IOStream
type instance O.AttributeList IOStream = IOStreamAttributeList
type IOStreamAttributeList = ('[ '("closed", IOStreamClosedPropertyInfo), '("inputStream", IOStreamInputStreamPropertyInfo), '("outputStream", IOStreamOutputStreamPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
iOStreamClosed :: AttrLabelProxy "closed"
iOStreamClosed = AttrLabelProxy

iOStreamInputStream :: AttrLabelProxy "inputStream"
iOStreamInputStream = AttrLabelProxy

iOStreamOutputStream :: AttrLabelProxy "outputStream"
iOStreamOutputStream = AttrLabelProxy

#endif

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

#endif

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

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

-- | Clears the pending flag on /@stream@/.
-- 
-- /Since: 2.22/
iOStreamClearPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m ()
iOStreamClearPending :: a -> m ()
iOStreamClearPending stream :: 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 IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr IOStream -> IO ()
g_io_stream_clear_pending Ptr IOStream
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 IOStreamClearPendingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamClearPendingMethodInfo a signature where
    overloadedMethod = iOStreamClearPending

#endif

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

foreign import ccall "g_io_stream_close" g_io_stream_close :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    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. This will also
-- close the individual input and output streams, if they are not already
-- closed.
-- 
-- 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 NULL, 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 some streams
-- can use a faster close that doesn\'t block to e.g. check errors.
-- 
-- The default implementation of this method just calls close on the
-- individual input\/output streams.
-- 
-- /Since: 2.22/
iOStreamClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
iOStreamClose :: a -> Maybe b -> m ()
iOStreamClose stream :: a
stream cancellable :: 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 IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 IOStream -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_io_stream_close Ptr IOStream
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 IOStreamCloseMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsIOStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo IOStreamCloseMethodInfo a signature where
    overloadedMethod = iOStreamClose

#endif

-- method IOStream::close_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream" , 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_io_stream_close_async" g_io_stream_close_async :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    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.IOStream.iOStreamCloseFinish' to get
-- the result of the operation.
-- 
-- For behaviour details see 'GI.Gio.Objects.IOStream.iOStreamClose'.
-- 
-- 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.
-- 
-- /Since: 2.22/
iOStreamCloseAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> 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 ()
iOStreamCloseAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
iOStreamCloseAsync stream :: a
stream ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr IOStream
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_io_stream_close_async Ptr IOStream
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 IOStreamCloseAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsIOStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo IOStreamCloseAsyncMethodInfo a signature where
    overloadedMethod = iOStreamCloseAsync

#endif

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

-- | Closes a stream.
-- 
-- /Since: 2.22/
iOStreamCloseFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
iOStreamCloseFinish :: a -> b -> m ()
iOStreamCloseFinish stream :: a
stream result_ :: b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
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 IOStream -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_io_stream_close_finish Ptr IOStream
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 IOStreamCloseFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsIOStream a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo IOStreamCloseFinishMethodInfo a signature where
    overloadedMethod = iOStreamCloseFinish

#endif

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

foreign import ccall "g_io_stream_get_input_stream" g_io_stream_get_input_stream :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    IO (Ptr Gio.InputStream.InputStream)

-- | Gets the input stream for this object. This is used
-- for reading.
-- 
-- /Since: 2.22/
iOStreamGetInputStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m Gio.InputStream.InputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.InputStream.InputStream', owned by the t'GI.Gio.Objects.IOStream.IOStream'.
    -- Do not free.
iOStreamGetInputStream :: a -> m InputStream
iOStreamGetInputStream stream :: a
stream = IO InputStream -> m InputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr InputStream
result <- Ptr IOStream -> IO (Ptr InputStream)
g_io_stream_get_input_stream Ptr IOStream
stream'
    Text -> Ptr InputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iOStreamGetInputStream" Ptr InputStream
result
    InputStream
result' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result'

#if defined(ENABLE_OVERLOADING)
data IOStreamGetInputStreamMethodInfo
instance (signature ~ (m Gio.InputStream.InputStream), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamGetInputStreamMethodInfo a signature where
    overloadedMethod = iOStreamGetInputStream

#endif

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

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

-- | Gets the output stream for this object. This is used for
-- writing.
-- 
-- /Since: 2.22/
iOStreamGetOutputStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m Gio.OutputStream.OutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.OutputStream.OutputStream', owned by the t'GI.Gio.Objects.IOStream.IOStream'.
    -- Do not free.
iOStreamGetOutputStream :: a -> m OutputStream
iOStreamGetOutputStream stream :: a
stream = IO OutputStream -> m OutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OutputStream -> m OutputStream)
-> IO OutputStream -> m OutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr OutputStream
result <- Ptr IOStream -> IO (Ptr OutputStream)
g_io_stream_get_output_stream Ptr IOStream
stream'
    Text -> Ptr OutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iOStreamGetOutputStream" Ptr OutputStream
result
    OutputStream
result' <- ((ManagedPtr OutputStream -> OutputStream)
-> Ptr OutputStream -> IO OutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr OutputStream -> OutputStream
Gio.OutputStream.OutputStream) Ptr OutputStream
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    OutputStream -> IO OutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return OutputStream
result'

#if defined(ENABLE_OVERLOADING)
data IOStreamGetOutputStreamMethodInfo
instance (signature ~ (m Gio.OutputStream.OutputStream), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamGetOutputStreamMethodInfo a signature where
    overloadedMethod = iOStreamGetOutputStream

#endif

-- method IOStream::has_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream" , 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_io_stream_has_pending" g_io_stream_has_pending :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    IO CInt

-- | Checks if a stream has pending actions.
-- 
-- /Since: 2.22/
iOStreamHasPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@stream@/ has pending actions.
iOStreamHasPending :: a -> m Bool
iOStreamHasPending stream :: 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 IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CInt
result <- Ptr IOStream -> IO CInt
g_io_stream_has_pending Ptr IOStream
stream'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 IOStreamHasPendingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamHasPendingMethodInfo a signature where
    overloadedMethod = iOStreamHasPending

#endif

-- method IOStream::is_closed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream" , 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_io_stream_is_closed" g_io_stream_is_closed :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    IO CInt

-- | Checks if a stream is closed.
-- 
-- /Since: 2.22/
iOStreamIsClosed ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream is closed.
iOStreamIsClosed :: a -> m Bool
iOStreamIsClosed stream :: 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 IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CInt
result <- Ptr IOStream -> IO CInt
g_io_stream_is_closed Ptr IOStream
stream'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 IOStreamIsClosedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamIsClosedMethodInfo a signature where
    overloadedMethod = iOStreamIsClosed

#endif

-- method IOStream::set_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream" , 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_io_stream_set_pending" g_io_stream_set_pending :: 
    Ptr IOStream ->                         -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    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@/.
-- 
-- /Since: 2.22/
iOStreamSetPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
iOStreamSetPending :: a -> m ()
iOStreamSetPending stream :: 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 IOStream
stream' <- a -> IO (Ptr IOStream)
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 IOStream -> Ptr (Ptr GError) -> IO CInt
g_io_stream_set_pending Ptr IOStream
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 IOStreamSetPendingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsIOStream a) => O.MethodInfo IOStreamSetPendingMethodInfo a signature where
    overloadedMethod = iOStreamSetPending

#endif

-- method IOStream::splice_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream1"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream2"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "IOStreamSpliceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GIOStreamSpliceFlags."
--                 , 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_io_stream_splice_async" g_io_stream_splice_async :: 
    Ptr IOStream ->                         -- stream1 : TInterface (Name {namespace = "Gio", name = "IOStream"})
    Ptr IOStream ->                         -- stream2 : TInterface (Name {namespace = "Gio", name = "IOStream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "IOStreamSpliceFlags"})
    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 ()

-- | Asyncronously splice the output stream of /@stream1@/ to the input stream of
-- /@stream2@/, and splice the output stream of /@stream2@/ to the input stream of
-- /@stream1@/.
-- 
-- When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.IOStream.iOStreamSpliceFinish' to get the
-- result of the operation.
-- 
-- /Since: 2.28/
iOStreamSpliceAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsIOStream a, IsIOStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@stream1@/: a t'GI.Gio.Objects.IOStream.IOStream'.
    -> b
    -- ^ /@stream2@/: a t'GI.Gio.Objects.IOStream.IOStream'.
    -> [Gio.Flags.IOStreamSpliceFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.IOStreamSpliceFlags'.
    -> 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 ()
iOStreamSpliceAsync :: a
-> b
-> [IOStreamSpliceFlags]
-> Int32
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
iOStreamSpliceAsync stream1 :: a
stream1 stream2 :: b
stream2 flags :: [IOStreamSpliceFlags]
flags ioPriority :: Int32
ioPriority cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream1' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream1
    Ptr IOStream
stream2' <- b -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream2
    let flags' :: CUInt
flags' = [IOStreamSpliceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IOStreamSpliceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr IOStream
-> Ptr IOStream
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_io_stream_splice_async Ptr IOStream
stream1' Ptr IOStream
stream2' 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
stream1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream2
    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 IOStreamSpliceAsyncMethodInfo
instance (signature ~ (b -> [Gio.Flags.IOStreamSpliceFlags] -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsIOStream a, IsIOStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo IOStreamSpliceAsyncMethodInfo a signature where
    overloadedMethod = iOStreamSpliceAsync

#endif

-- method IOStream::splice_finish
-- method type : MemberFunction
-- Args: [ 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_io_stream_splice_finish" g_io_stream_splice_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous io stream splice operation.
-- 
-- /Since: 2.28/
iOStreamSpliceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
iOStreamSpliceFinish :: a -> m ()
iOStreamSpliceFinish result_ :: a
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 AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
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 AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_io_stream_splice_finish Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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)
#endif