{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Data input stream implements t'GI.Gio.Objects.InputStream.InputStream' and includes functions
-- for reading structured data directly from a binary input stream.

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

module GI.Gio.Objects.DataInputStream
    ( 

-- * Exported types
    DataInputStream(..)                     ,
    IsDataInputStream                       ,
    toDataInputStream                       ,


 -- * 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"), [canSeek]("GI.Gio.Interfaces.Seekable#g:method:canSeek"), [canTruncate]("GI.Gio.Interfaces.Seekable#g:method:canTruncate"), [clearPending]("GI.Gio.Objects.InputStream#g:method:clearPending"), [close]("GI.Gio.Objects.InputStream#g:method:close"), [closeAsync]("GI.Gio.Objects.InputStream#g:method:closeAsync"), [closeFinish]("GI.Gio.Objects.InputStream#g:method:closeFinish"), [fill]("GI.Gio.Objects.BufferedInputStream#g:method:fill"), [fillAsync]("GI.Gio.Objects.BufferedInputStream#g:method:fillAsync"), [fillFinish]("GI.Gio.Objects.BufferedInputStream#g:method:fillFinish"), [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.InputStream#g:method:hasPending"), [isClosed]("GI.Gio.Objects.InputStream#g:method:isClosed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [peek]("GI.Gio.Objects.BufferedInputStream#g:method:peek"), [peekBuffer]("GI.Gio.Objects.BufferedInputStream#g:method:peekBuffer"), [read]("GI.Gio.Objects.InputStream#g:method:read"), [readAll]("GI.Gio.Objects.InputStream#g:method:readAll"), [readAllAsync]("GI.Gio.Objects.InputStream#g:method:readAllAsync"), [readAllFinish]("GI.Gio.Objects.InputStream#g:method:readAllFinish"), [readAsync]("GI.Gio.Objects.InputStream#g:method:readAsync"), [readByte]("GI.Gio.Objects.DataInputStream#g:method:readByte"), [readBytes]("GI.Gio.Objects.InputStream#g:method:readBytes"), [readBytesAsync]("GI.Gio.Objects.InputStream#g:method:readBytesAsync"), [readBytesFinish]("GI.Gio.Objects.InputStream#g:method:readBytesFinish"), [readFinish]("GI.Gio.Objects.InputStream#g:method:readFinish"), [readInt16]("GI.Gio.Objects.DataInputStream#g:method:readInt16"), [readInt32]("GI.Gio.Objects.DataInputStream#g:method:readInt32"), [readInt64]("GI.Gio.Objects.DataInputStream#g:method:readInt64"), [readLine]("GI.Gio.Objects.DataInputStream#g:method:readLine"), [readLineAsync]("GI.Gio.Objects.DataInputStream#g:method:readLineAsync"), [readLineFinish]("GI.Gio.Objects.DataInputStream#g:method:readLineFinish"), [readLineFinishUtf8]("GI.Gio.Objects.DataInputStream#g:method:readLineFinishUtf8"), [readLineUtf8]("GI.Gio.Objects.DataInputStream#g:method:readLineUtf8"), [readUint16]("GI.Gio.Objects.DataInputStream#g:method:readUint16"), [readUint32]("GI.Gio.Objects.DataInputStream#g:method:readUint32"), [readUint64]("GI.Gio.Objects.DataInputStream#g:method:readUint64"), [readUntil]("GI.Gio.Objects.DataInputStream#g:method:readUntil"), [readUntilAsync]("GI.Gio.Objects.DataInputStream#g:method:readUntilAsync"), [readUntilFinish]("GI.Gio.Objects.DataInputStream#g:method:readUntilFinish"), [readUpto]("GI.Gio.Objects.DataInputStream#g:method:readUpto"), [readUptoAsync]("GI.Gio.Objects.DataInputStream#g:method:readUptoAsync"), [readUptoFinish]("GI.Gio.Objects.DataInputStream#g:method:readUptoFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [seek]("GI.Gio.Interfaces.Seekable#g:method:seek"), [skip]("GI.Gio.Objects.InputStream#g:method:skip"), [skipAsync]("GI.Gio.Objects.InputStream#g:method:skipAsync"), [skipFinish]("GI.Gio.Objects.InputStream#g:method:skipFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [tell]("GI.Gio.Interfaces.Seekable#g:method:tell"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [truncate]("GI.Gio.Interfaces.Seekable#g:method:truncate"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAvailable]("GI.Gio.Objects.BufferedInputStream#g:method:getAvailable"), [getBaseStream]("GI.Gio.Objects.FilterInputStream#g:method:getBaseStream"), [getBufferSize]("GI.Gio.Objects.BufferedInputStream#g:method:getBufferSize"), [getByteOrder]("GI.Gio.Objects.DataInputStream#g:method:getByteOrder"), [getCloseBaseStream]("GI.Gio.Objects.FilterInputStream#g:method:getCloseBaseStream"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getNewlineType]("GI.Gio.Objects.DataInputStream#g:method:getNewlineType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setBufferSize]("GI.Gio.Objects.BufferedInputStream#g:method:setBufferSize"), [setByteOrder]("GI.Gio.Objects.DataInputStream#g:method:setByteOrder"), [setCloseBaseStream]("GI.Gio.Objects.FilterInputStream#g:method:setCloseBaseStream"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setNewlineType]("GI.Gio.Objects.DataInputStream#g:method:setNewlineType"), [setPending]("GI.Gio.Objects.InputStream#g:method:setPending"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDataInputStreamMethod            ,
#endif

-- ** getByteOrder #method:getByteOrder#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamGetByteOrderMethodInfo   ,
#endif
    dataInputStreamGetByteOrder             ,


-- ** getNewlineType #method:getNewlineType#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamGetNewlineTypeMethodInfo ,
#endif
    dataInputStreamGetNewlineType           ,


-- ** new #method:new#

    dataInputStreamNew                      ,


-- ** readByte #method:readByte#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadByteMethodInfo       ,
#endif
    dataInputStreamReadByte                 ,


-- ** readInt16 #method:readInt16#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadInt16MethodInfo      ,
#endif
    dataInputStreamReadInt16                ,


-- ** readInt32 #method:readInt32#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadInt32MethodInfo      ,
#endif
    dataInputStreamReadInt32                ,


-- ** readInt64 #method:readInt64#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadInt64MethodInfo      ,
#endif
    dataInputStreamReadInt64                ,


-- ** readLine #method:readLine#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadLineMethodInfo       ,
#endif
    dataInputStreamReadLine                 ,


-- ** readLineAsync #method:readLineAsync#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadLineAsyncMethodInfo  ,
#endif
    dataInputStreamReadLineAsync            ,


-- ** readLineFinish #method:readLineFinish#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadLineFinishMethodInfo ,
#endif
    dataInputStreamReadLineFinish           ,


-- ** readLineFinishUtf8 #method:readLineFinishUtf8#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadLineFinishUtf8MethodInfo,
#endif
    dataInputStreamReadLineFinishUtf8       ,


-- ** readLineUtf8 #method:readLineUtf8#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadLineUtf8MethodInfo   ,
#endif
    dataInputStreamReadLineUtf8             ,


-- ** readUint16 #method:readUint16#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUint16MethodInfo     ,
#endif
    dataInputStreamReadUint16               ,


-- ** readUint32 #method:readUint32#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUint32MethodInfo     ,
#endif
    dataInputStreamReadUint32               ,


-- ** readUint64 #method:readUint64#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUint64MethodInfo     ,
#endif
    dataInputStreamReadUint64               ,


-- ** readUntil #method:readUntil#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUntilMethodInfo      ,
#endif
    dataInputStreamReadUntil                ,


-- ** readUntilAsync #method:readUntilAsync#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUntilAsyncMethodInfo ,
#endif
    dataInputStreamReadUntilAsync           ,


-- ** readUntilFinish #method:readUntilFinish#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUntilFinishMethodInfo,
#endif
    dataInputStreamReadUntilFinish          ,


-- ** readUpto #method:readUpto#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUptoMethodInfo       ,
#endif
    dataInputStreamReadUpto                 ,


-- ** readUptoAsync #method:readUptoAsync#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUptoAsyncMethodInfo  ,
#endif
    dataInputStreamReadUptoAsync            ,


-- ** readUptoFinish #method:readUptoFinish#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamReadUptoFinishMethodInfo ,
#endif
    dataInputStreamReadUptoFinish           ,


-- ** setByteOrder #method:setByteOrder#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamSetByteOrderMethodInfo   ,
#endif
    dataInputStreamSetByteOrder             ,


-- ** setNewlineType #method:setNewlineType#

#if defined(ENABLE_OVERLOADING)
    DataInputStreamSetNewlineTypeMethodInfo ,
#endif
    dataInputStreamSetNewlineType           ,




 -- * Properties


-- ** byteOrder #attr:byteOrder#
-- | The :byte-order property determines the byte ordering that
-- is used when reading multi-byte entities (such as integers)
-- from the stream.

#if defined(ENABLE_OVERLOADING)
    DataInputStreamByteOrderPropertyInfo    ,
#endif
    constructDataInputStreamByteOrder       ,
#if defined(ENABLE_OVERLOADING)
    dataInputStreamByteOrder                ,
#endif
    getDataInputStreamByteOrder             ,
    setDataInputStreamByteOrder             ,


-- ** newlineType #attr:newlineType#
-- | The :newline-type property determines what is considered
-- as a line ending when reading complete lines from the stream.

#if defined(ENABLE_OVERLOADING)
    DataInputStreamNewlineTypePropertyInfo  ,
#endif
    constructDataInputStreamNewlineType     ,
#if defined(ENABLE_OVERLOADING)
    dataInputStreamNewlineType              ,
#endif
    getDataInputStreamNewlineType           ,
    setDataInputStreamNewlineType           ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Enums as GLib.Enums
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import qualified GI.GLib.Structs.Source as GLib.Source
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Seekable as Gio.Seekable
import {-# SOURCE #-} qualified GI.Gio.Objects.BufferedInputStream as Gio.BufferedInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FilterInputStream as Gio.FilterInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Seekable as Gio.Seekable
import {-# SOURCE #-} qualified GI.Gio.Objects.BufferedInputStream as Gio.BufferedInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FilterInputStream as Gio.FilterInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream

#endif

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

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

foreign import ccall "g_data_input_stream_get_type"
    c_g_data_input_stream_get_type :: IO B.Types.GType

instance B.Types.TypedObject DataInputStream where
    glibType :: IO GType
glibType = IO GType
c_g_data_input_stream_get_type

instance B.Types.GObject DataInputStream

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

instance O.HasParentTypes DataInputStream
type instance O.ParentTypes DataInputStream = '[Gio.BufferedInputStream.BufferedInputStream, Gio.FilterInputStream.FilterInputStream, Gio.InputStream.InputStream, GObject.Object.Object, Gio.Seekable.Seekable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDataInputStreamMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDataInputStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDataInputStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDataInputStreamMethod "canSeek" o = Gio.Seekable.SeekableCanSeekMethodInfo
    ResolveDataInputStreamMethod "canTruncate" o = Gio.Seekable.SeekableCanTruncateMethodInfo
    ResolveDataInputStreamMethod "clearPending" o = Gio.InputStream.InputStreamClearPendingMethodInfo
    ResolveDataInputStreamMethod "close" o = Gio.InputStream.InputStreamCloseMethodInfo
    ResolveDataInputStreamMethod "closeAsync" o = Gio.InputStream.InputStreamCloseAsyncMethodInfo
    ResolveDataInputStreamMethod "closeFinish" o = Gio.InputStream.InputStreamCloseFinishMethodInfo
    ResolveDataInputStreamMethod "fill" o = Gio.BufferedInputStream.BufferedInputStreamFillMethodInfo
    ResolveDataInputStreamMethod "fillAsync" o = Gio.BufferedInputStream.BufferedInputStreamFillAsyncMethodInfo
    ResolveDataInputStreamMethod "fillFinish" o = Gio.BufferedInputStream.BufferedInputStreamFillFinishMethodInfo
    ResolveDataInputStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDataInputStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDataInputStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDataInputStreamMethod "hasPending" o = Gio.InputStream.InputStreamHasPendingMethodInfo
    ResolveDataInputStreamMethod "isClosed" o = Gio.InputStream.InputStreamIsClosedMethodInfo
    ResolveDataInputStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDataInputStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDataInputStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDataInputStreamMethod "peek" o = Gio.BufferedInputStream.BufferedInputStreamPeekMethodInfo
    ResolveDataInputStreamMethod "peekBuffer" o = Gio.BufferedInputStream.BufferedInputStreamPeekBufferMethodInfo
    ResolveDataInputStreamMethod "read" o = Gio.InputStream.InputStreamReadMethodInfo
    ResolveDataInputStreamMethod "readAll" o = Gio.InputStream.InputStreamReadAllMethodInfo
    ResolveDataInputStreamMethod "readAllAsync" o = Gio.InputStream.InputStreamReadAllAsyncMethodInfo
    ResolveDataInputStreamMethod "readAllFinish" o = Gio.InputStream.InputStreamReadAllFinishMethodInfo
    ResolveDataInputStreamMethod "readAsync" o = Gio.InputStream.InputStreamReadAsyncMethodInfo
    ResolveDataInputStreamMethod "readByte" o = DataInputStreamReadByteMethodInfo
    ResolveDataInputStreamMethod "readBytes" o = Gio.InputStream.InputStreamReadBytesMethodInfo
    ResolveDataInputStreamMethod "readBytesAsync" o = Gio.InputStream.InputStreamReadBytesAsyncMethodInfo
    ResolveDataInputStreamMethod "readBytesFinish" o = Gio.InputStream.InputStreamReadBytesFinishMethodInfo
    ResolveDataInputStreamMethod "readFinish" o = Gio.InputStream.InputStreamReadFinishMethodInfo
    ResolveDataInputStreamMethod "readInt16" o = DataInputStreamReadInt16MethodInfo
    ResolveDataInputStreamMethod "readInt32" o = DataInputStreamReadInt32MethodInfo
    ResolveDataInputStreamMethod "readInt64" o = DataInputStreamReadInt64MethodInfo
    ResolveDataInputStreamMethod "readLine" o = DataInputStreamReadLineMethodInfo
    ResolveDataInputStreamMethod "readLineAsync" o = DataInputStreamReadLineAsyncMethodInfo
    ResolveDataInputStreamMethod "readLineFinish" o = DataInputStreamReadLineFinishMethodInfo
    ResolveDataInputStreamMethod "readLineFinishUtf8" o = DataInputStreamReadLineFinishUtf8MethodInfo
    ResolveDataInputStreamMethod "readLineUtf8" o = DataInputStreamReadLineUtf8MethodInfo
    ResolveDataInputStreamMethod "readUint16" o = DataInputStreamReadUint16MethodInfo
    ResolveDataInputStreamMethod "readUint32" o = DataInputStreamReadUint32MethodInfo
    ResolveDataInputStreamMethod "readUint64" o = DataInputStreamReadUint64MethodInfo
    ResolveDataInputStreamMethod "readUntil" o = DataInputStreamReadUntilMethodInfo
    ResolveDataInputStreamMethod "readUntilAsync" o = DataInputStreamReadUntilAsyncMethodInfo
    ResolveDataInputStreamMethod "readUntilFinish" o = DataInputStreamReadUntilFinishMethodInfo
    ResolveDataInputStreamMethod "readUpto" o = DataInputStreamReadUptoMethodInfo
    ResolveDataInputStreamMethod "readUptoAsync" o = DataInputStreamReadUptoAsyncMethodInfo
    ResolveDataInputStreamMethod "readUptoFinish" o = DataInputStreamReadUptoFinishMethodInfo
    ResolveDataInputStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDataInputStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDataInputStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDataInputStreamMethod "seek" o = Gio.Seekable.SeekableSeekMethodInfo
    ResolveDataInputStreamMethod "skip" o = Gio.InputStream.InputStreamSkipMethodInfo
    ResolveDataInputStreamMethod "skipAsync" o = Gio.InputStream.InputStreamSkipAsyncMethodInfo
    ResolveDataInputStreamMethod "skipFinish" o = Gio.InputStream.InputStreamSkipFinishMethodInfo
    ResolveDataInputStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDataInputStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDataInputStreamMethod "tell" o = Gio.Seekable.SeekableTellMethodInfo
    ResolveDataInputStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDataInputStreamMethod "truncate" o = Gio.Seekable.SeekableTruncateMethodInfo
    ResolveDataInputStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDataInputStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDataInputStreamMethod "getAvailable" o = Gio.BufferedInputStream.BufferedInputStreamGetAvailableMethodInfo
    ResolveDataInputStreamMethod "getBaseStream" o = Gio.FilterInputStream.FilterInputStreamGetBaseStreamMethodInfo
    ResolveDataInputStreamMethod "getBufferSize" o = Gio.BufferedInputStream.BufferedInputStreamGetBufferSizeMethodInfo
    ResolveDataInputStreamMethod "getByteOrder" o = DataInputStreamGetByteOrderMethodInfo
    ResolveDataInputStreamMethod "getCloseBaseStream" o = Gio.FilterInputStream.FilterInputStreamGetCloseBaseStreamMethodInfo
    ResolveDataInputStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDataInputStreamMethod "getNewlineType" o = DataInputStreamGetNewlineTypeMethodInfo
    ResolveDataInputStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDataInputStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDataInputStreamMethod "setBufferSize" o = Gio.BufferedInputStream.BufferedInputStreamSetBufferSizeMethodInfo
    ResolveDataInputStreamMethod "setByteOrder" o = DataInputStreamSetByteOrderMethodInfo
    ResolveDataInputStreamMethod "setCloseBaseStream" o = Gio.FilterInputStream.FilterInputStreamSetCloseBaseStreamMethodInfo
    ResolveDataInputStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDataInputStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDataInputStreamMethod "setNewlineType" o = DataInputStreamSetNewlineTypeMethodInfo
    ResolveDataInputStreamMethod "setPending" o = Gio.InputStream.InputStreamSetPendingMethodInfo
    ResolveDataInputStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDataInputStreamMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "byte-order"
   -- Type: TInterface (Name {namespace = "Gio", name = "DataStreamByteOrder"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@byte-order@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dataInputStream #byteOrder
-- @
getDataInputStreamByteOrder :: (MonadIO m, IsDataInputStream o) => o -> m Gio.Enums.DataStreamByteOrder
getDataInputStreamByteOrder :: forall (m :: * -> *) o.
(MonadIO m, IsDataInputStream o) =>
o -> m DataStreamByteOrder
getDataInputStreamByteOrder o
obj = IO DataStreamByteOrder -> m DataStreamByteOrder
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DataStreamByteOrder -> m DataStreamByteOrder)
-> IO DataStreamByteOrder -> m DataStreamByteOrder
forall a b. (a -> b) -> a -> b
$ o -> String -> IO DataStreamByteOrder
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"byte-order"

-- | Set the value of the “@byte-order@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dataInputStream [ #byteOrder 'Data.GI.Base.Attributes.:=' value ]
-- @
setDataInputStreamByteOrder :: (MonadIO m, IsDataInputStream o) => o -> Gio.Enums.DataStreamByteOrder -> m ()
setDataInputStreamByteOrder :: forall (m :: * -> *) o.
(MonadIO m, IsDataInputStream o) =>
o -> DataStreamByteOrder -> m ()
setDataInputStreamByteOrder o
obj DataStreamByteOrder
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> DataStreamByteOrder -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"byte-order" DataStreamByteOrder
val

-- | Construct a `GValueConstruct` with valid value for the “@byte-order@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDataInputStreamByteOrder :: (IsDataInputStream o, MIO.MonadIO m) => Gio.Enums.DataStreamByteOrder -> m (GValueConstruct o)
constructDataInputStreamByteOrder :: forall o (m :: * -> *).
(IsDataInputStream o, MonadIO m) =>
DataStreamByteOrder -> m (GValueConstruct o)
constructDataInputStreamByteOrder DataStreamByteOrder
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> DataStreamByteOrder -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"byte-order" DataStreamByteOrder
val

#if defined(ENABLE_OVERLOADING)
data DataInputStreamByteOrderPropertyInfo
instance AttrInfo DataInputStreamByteOrderPropertyInfo where
    type AttrAllowedOps DataInputStreamByteOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DataInputStreamByteOrderPropertyInfo = IsDataInputStream
    type AttrSetTypeConstraint DataInputStreamByteOrderPropertyInfo = (~) Gio.Enums.DataStreamByteOrder
    type AttrTransferTypeConstraint DataInputStreamByteOrderPropertyInfo = (~) Gio.Enums.DataStreamByteOrder
    type AttrTransferType DataInputStreamByteOrderPropertyInfo = Gio.Enums.DataStreamByteOrder
    type AttrGetType DataInputStreamByteOrderPropertyInfo = Gio.Enums.DataStreamByteOrder
    type AttrLabel DataInputStreamByteOrderPropertyInfo = "byte-order"
    type AttrOrigin DataInputStreamByteOrderPropertyInfo = DataInputStream
    attrGet = getDataInputStreamByteOrder
    attrSet = setDataInputStreamByteOrder
    attrTransfer _ v = do
        return v
    attrConstruct = constructDataInputStreamByteOrder
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DataInputStream.byteOrder"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DataInputStream.html#g:attr:byteOrder"
        })
#endif

-- VVV Prop "newline-type"
   -- Type: TInterface (Name {namespace = "Gio", name = "DataStreamNewlineType"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@newline-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dataInputStream #newlineType
-- @
getDataInputStreamNewlineType :: (MonadIO m, IsDataInputStream o) => o -> m Gio.Enums.DataStreamNewlineType
getDataInputStreamNewlineType :: forall (m :: * -> *) o.
(MonadIO m, IsDataInputStream o) =>
o -> m DataStreamNewlineType
getDataInputStreamNewlineType o
obj = IO DataStreamNewlineType -> m DataStreamNewlineType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DataStreamNewlineType -> m DataStreamNewlineType)
-> IO DataStreamNewlineType -> m DataStreamNewlineType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO DataStreamNewlineType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"newline-type"

-- | Set the value of the “@newline-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dataInputStream [ #newlineType 'Data.GI.Base.Attributes.:=' value ]
-- @
setDataInputStreamNewlineType :: (MonadIO m, IsDataInputStream o) => o -> Gio.Enums.DataStreamNewlineType -> m ()
setDataInputStreamNewlineType :: forall (m :: * -> *) o.
(MonadIO m, IsDataInputStream o) =>
o -> DataStreamNewlineType -> m ()
setDataInputStreamNewlineType o
obj DataStreamNewlineType
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> DataStreamNewlineType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"newline-type" DataStreamNewlineType
val

-- | Construct a `GValueConstruct` with valid value for the “@newline-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDataInputStreamNewlineType :: (IsDataInputStream o, MIO.MonadIO m) => Gio.Enums.DataStreamNewlineType -> m (GValueConstruct o)
constructDataInputStreamNewlineType :: forall o (m :: * -> *).
(IsDataInputStream o, MonadIO m) =>
DataStreamNewlineType -> m (GValueConstruct o)
constructDataInputStreamNewlineType DataStreamNewlineType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> DataStreamNewlineType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"newline-type" DataStreamNewlineType
val

#if defined(ENABLE_OVERLOADING)
data DataInputStreamNewlineTypePropertyInfo
instance AttrInfo DataInputStreamNewlineTypePropertyInfo where
    type AttrAllowedOps DataInputStreamNewlineTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DataInputStreamNewlineTypePropertyInfo = IsDataInputStream
    type AttrSetTypeConstraint DataInputStreamNewlineTypePropertyInfo = (~) Gio.Enums.DataStreamNewlineType
    type AttrTransferTypeConstraint DataInputStreamNewlineTypePropertyInfo = (~) Gio.Enums.DataStreamNewlineType
    type AttrTransferType DataInputStreamNewlineTypePropertyInfo = Gio.Enums.DataStreamNewlineType
    type AttrGetType DataInputStreamNewlineTypePropertyInfo = Gio.Enums.DataStreamNewlineType
    type AttrLabel DataInputStreamNewlineTypePropertyInfo = "newline-type"
    type AttrOrigin DataInputStreamNewlineTypePropertyInfo = DataInputStream
    attrGet = getDataInputStreamNewlineType
    attrSet = setDataInputStreamNewlineType
    attrTransfer _ v = do
        return v
    attrConstruct = constructDataInputStreamNewlineType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DataInputStream.newlineType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DataInputStream.html#g:attr:newlineType"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DataInputStream
type instance O.AttributeList DataInputStream = DataInputStreamAttributeList
type DataInputStreamAttributeList = ('[ '("baseStream", Gio.FilterInputStream.FilterInputStreamBaseStreamPropertyInfo), '("bufferSize", Gio.BufferedInputStream.BufferedInputStreamBufferSizePropertyInfo), '("byteOrder", DataInputStreamByteOrderPropertyInfo), '("closeBaseStream", Gio.FilterInputStream.FilterInputStreamCloseBaseStreamPropertyInfo), '("newlineType", DataInputStreamNewlineTypePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
dataInputStreamByteOrder :: AttrLabelProxy "byteOrder"
dataInputStreamByteOrder = AttrLabelProxy

dataInputStreamNewlineType :: AttrLabelProxy "newlineType"
dataInputStreamNewlineType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DataInputStream = DataInputStreamSignalList
type DataInputStreamSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method DataInputStream::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "base_stream"
--           , 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DataInputStream" })
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_new" g_data_input_stream_new :: 
    Ptr Gio.InputStream.InputStream ->      -- base_stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    IO (Ptr DataInputStream)

-- | Creates a new data input stream for the /@baseStream@/.
dataInputStreamNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a) =>
    a
    -- ^ /@baseStream@/: a t'GI.Gio.Objects.InputStream.InputStream'.
    -> m DataInputStream
    -- ^ __Returns:__ a new t'GI.Gio.Objects.DataInputStream.DataInputStream'.
dataInputStreamNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputStream a) =>
a -> m DataInputStream
dataInputStreamNew a
baseStream = IO DataInputStream -> m DataInputStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DataInputStream -> m DataInputStream)
-> IO DataInputStream -> m DataInputStream
forall a b. (a -> b) -> a -> b
$ do
    baseStream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseStream
    result <- g_data_input_stream_new baseStream'
    checkUnexpectedReturnNULL "dataInputStreamNew" result
    result' <- (wrapObject DataInputStream) result
    touchManagedPtr baseStream
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Gets the byte order for the data input stream.
dataInputStreamGetByteOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> m Gio.Enums.DataStreamByteOrder
    -- ^ __Returns:__ the /@stream@/\'s current t'GI.Gio.Enums.DataStreamByteOrder'.
dataInputStreamGetByteOrder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDataInputStream a) =>
a -> m DataStreamByteOrder
dataInputStreamGetByteOrder a
stream = IO DataStreamByteOrder -> m DataStreamByteOrder
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DataStreamByteOrder -> m DataStreamByteOrder)
-> IO DataStreamByteOrder -> m DataStreamByteOrder
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result <- g_data_input_stream_get_byte_order stream'
    let result' = (Int -> DataStreamByteOrder
forall a. Enum a => Int -> a
toEnum (Int -> DataStreamByteOrder)
-> (CUInt -> Int) -> CUInt -> DataStreamByteOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr stream
    return result'

#if defined(ENABLE_OVERLOADING)
data DataInputStreamGetByteOrderMethodInfo
instance (signature ~ (m Gio.Enums.DataStreamByteOrder), MonadIO m, IsDataInputStream a) => O.OverloadedMethod DataInputStreamGetByteOrderMethodInfo a signature where
    overloadedMethod = dataInputStreamGetByteOrder

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


#endif

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

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

-- | Gets the current newline type for the /@stream@/.
dataInputStreamGetNewlineType ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> m Gio.Enums.DataStreamNewlineType
    -- ^ __Returns:__ t'GI.Gio.Enums.DataStreamNewlineType' for the given /@stream@/.
dataInputStreamGetNewlineType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDataInputStream a) =>
a -> m DataStreamNewlineType
dataInputStreamGetNewlineType a
stream = IO DataStreamNewlineType -> m DataStreamNewlineType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DataStreamNewlineType -> m DataStreamNewlineType)
-> IO DataStreamNewlineType -> m DataStreamNewlineType
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result <- g_data_input_stream_get_newline_type stream'
    let result' = (Int -> DataStreamNewlineType
forall a. Enum a => Int -> a
toEnum (Int -> DataStreamNewlineType)
-> (CUInt -> Int) -> CUInt -> DataStreamNewlineType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr stream
    return result'

#if defined(ENABLE_OVERLOADING)
data DataInputStreamGetNewlineTypeMethodInfo
instance (signature ~ (m Gio.Enums.DataStreamNewlineType), MonadIO m, IsDataInputStream a) => O.OverloadedMethod DataInputStreamGetNewlineTypeMethodInfo a signature where
    overloadedMethod = dataInputStreamGetNewlineType

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


#endif

-- method DataInputStream::read_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_byte" g_data_input_stream_read_byte :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Word8

-- | Reads an unsigned 8-bit\/1-byte value from /@stream@/.
dataInputStreamReadByte ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Word8
    -- ^ __Returns:__ an unsigned 8-bit\/1-byte value read from the /@stream@/ or @0@
    -- if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadByte :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Word8
dataInputStreamReadByte a
stream Maybe b
cancellable = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_byte stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadByteMethodInfo
instance (signature ~ (Maybe (b) -> m Word8), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadByteMethodInfo a signature where
    overloadedMethod = dataInputStreamReadByte

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


#endif

-- method DataInputStream::read_int16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt16)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_int16" g_data_input_stream_read_int16 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int16

-- | Reads a 16-bit\/2-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder' and 'GI.Gio.Objects.DataInputStream.dataInputStreamSetByteOrder'.
dataInputStreamReadInt16 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Int16
    -- ^ __Returns:__ a signed 16-bit\/2-byte value read from /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadInt16 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Int16
dataInputStreamReadInt16 a
stream Maybe b
cancellable = IO Int16 -> m Int16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int16 -> m Int16) -> IO Int16 -> m Int16
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_int16 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadInt16MethodInfo
instance (signature ~ (Maybe (b) -> m Int16), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadInt16MethodInfo a signature where
    overloadedMethod = dataInputStreamReadInt16

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


#endif

-- method DataInputStream::read_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt32)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_int32" g_data_input_stream_read_int32 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Reads a signed 32-bit\/4-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder' and 'GI.Gio.Objects.DataInputStream.dataInputStreamSetByteOrder'.
-- 
-- 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.
dataInputStreamReadInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Int32
    -- ^ __Returns:__ a signed 32-bit\/4-byte value read from the /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadInt32 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Int32
dataInputStreamReadInt32 a
stream Maybe b
cancellable = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_int32 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadInt32MethodInfo
instance (signature ~ (Maybe (b) -> m Int32), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadInt32MethodInfo a signature where
    overloadedMethod = dataInputStreamReadInt32

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


#endif

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

foreign import ccall "g_data_input_stream_read_int64" g_data_input_stream_read_int64 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Reads a 64-bit\/8-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder' and 'GI.Gio.Objects.DataInputStream.dataInputStreamSetByteOrder'.
-- 
-- 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.
dataInputStreamReadInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Int64
    -- ^ __Returns:__ a signed 64-bit\/8-byte value read from /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadInt64 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Int64
dataInputStreamReadInt64 a
stream Maybe b
cancellable = IO Int64 -> m Int64
forall a. IO a -> m a
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
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_int64 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

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

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


#endif

-- method DataInputStream::read_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUInt8))
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_line" g_data_input_stream_read_line :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Word8)

-- | Reads a line from the data input stream.  Note that no encoding
-- checks or conversion is performed; the input is not guaranteed to
-- be UTF-8, and may in fact have embedded NUL characters.
-- 
-- 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.
dataInputStreamReadLine ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ((Maybe ByteString, FCT.CSize))
    -- ^ __Returns:__ 
    --  a NUL terminated byte array with the line that was read in
    --  (without the newlines).  Set /@length@/ to a @/gsize/@ to get the length
    --  of the read line.  On an error, it will return 'P.Nothing' and /@error@/
    --  will be set. If there\'s no content to read, it will still return
    --  'P.Nothing', but /@error@/ won\'t be set. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadLine :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m (Maybe ByteString, CSize)
dataInputStreamReadLine a
stream Maybe b
cancellable = IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize))
-> IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_line stream' length_ maybeCancellable
        maybeResult <- convertIfNonNull result $ \Ptr Word8
result' -> do
            result'' <- Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString Ptr Word8
result'
            freeMem result'
            return result''
        length_' <- peek length_
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        freeMem length_
        return (maybeResult, length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineMethodInfo
instance (signature ~ (Maybe (b) -> m ((Maybe ByteString, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadLineMethodInfo a signature where
    overloadedMethod = dataInputStreamReadLine

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


#endif

-- method DataInputStream::read_line_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_read_line_async" g_data_input_stream_read_line_async :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    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 ()

-- | The asynchronous version of 'GI.Gio.Objects.DataInputStream.dataInputStreamReadLine'.  It is
-- an error to have two outstanding calls to this function.
-- 
-- When the operation is finished, /@callback@/ will be called. You
-- can then call 'GI.Gio.Objects.DataInputStream.dataInputStreamReadLineFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.20/
dataInputStreamReadLineAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][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 ()
dataInputStreamReadLineAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dataInputStreamReadLineAsync a
stream Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_data_input_stream_read_line_async stream' ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr stream
    whenJust cancellable touchManagedPtr
    return ()

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

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


#endif

-- method DataInputStream::read_line_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult that was provided to the callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUInt8))
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_line_finish" g_data_input_stream_read_line_finish :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Word8)

-- | Finish an asynchronous call started by
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadLineAsync'.  Note the warning about
-- string encoding in 'GI.Gio.Objects.DataInputStream.dataInputStreamReadLine' applies here as
-- well.
-- 
-- /Since: 2.20/
dataInputStreamReadLineFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' that was provided to the callback.
    -> m ((Maybe ByteString, FCT.CSize))
    -- ^ __Returns:__ 
    --  a NUL-terminated byte array with the line that was read in
    --  (without the newlines).  Set /@length@/ to a @/gsize/@ to get the length
    --  of the read line.  On an error, it will return 'P.Nothing' and /@error@/
    --  will be set. If there\'s no content to read, it will still return
    --  'P.Nothing', but /@error@/ won\'t be set. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadLineFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsAsyncResult b) =>
a -> b -> m (Maybe ByteString, CSize)
dataInputStreamReadLineFinish a
stream b
result_ = IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize))
-> IO (Maybe ByteString, CSize) -> m (Maybe ByteString, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result_' <- unsafeManagedPtrCastPtr result_
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    onException (do
        result <- propagateGError $ g_data_input_stream_read_line_finish stream' result_' length_
        maybeResult <- convertIfNonNull result $ \Ptr Word8
result' -> do
            result'' <- Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString Ptr Word8
result'
            freeMem result'
            return result''
        length_' <- peek length_
        touchManagedPtr stream
        touchManagedPtr result_
        freeMem length_
        return (maybeResult, length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineFinishMethodInfo
instance (signature ~ (b -> m ((Maybe ByteString, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DataInputStreamReadLineFinishMethodInfo a signature where
    overloadedMethod = dataInputStreamReadLineFinish

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


#endif

-- method DataInputStream::read_line_finish_utf8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult that was provided to the callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_line_finish_utf8" g_data_input_stream_read_line_finish_utf8 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Finish an asynchronous call started by
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadLineAsync'.
-- 
-- /Since: 2.30/
dataInputStreamReadLineFinishUtf8 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' that was provided to the callback.
    -> m ((Maybe T.Text, FCT.CSize))
    -- ^ __Returns:__ a string with the line that
    --  was read in (without the newlines).  Set /@length@/ to a @/gsize/@ to
    --  get the length of the read line.  On an error, it will return
    --  'P.Nothing' and /@error@/ will be set. For UTF-8 conversion errors, the set
    --  error domain is @/G_CONVERT_ERROR/@.  If there\'s no content to read,
    --  it will still return 'P.Nothing', but /@error@/ won\'t be set. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadLineFinishUtf8 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsAsyncResult b) =>
a -> b -> m (Maybe Text, CSize)
dataInputStreamReadLineFinishUtf8 a
stream b
result_ = IO (Maybe Text, CSize) -> m (Maybe Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, CSize) -> m (Maybe Text, CSize))
-> IO (Maybe Text, CSize) -> m (Maybe Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result_' <- unsafeManagedPtrCastPtr result_
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    onException (do
        result <- propagateGError $ g_data_input_stream_read_line_finish_utf8 stream' result_' length_
        maybeResult <- convertIfNonNull result $ \CString
result' -> do
            result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            freeMem result'
            return result''
        length_' <- peek length_
        touchManagedPtr stream
        touchManagedPtr result_
        freeMem length_
        return (maybeResult, length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineFinishUtf8MethodInfo
instance (signature ~ (b -> m ((Maybe T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DataInputStreamReadLineFinishUtf8MethodInfo a signature where
    overloadedMethod = dataInputStreamReadLineFinishUtf8

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


#endif

-- method DataInputStream::read_line_utf8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_line_utf8" g_data_input_stream_read_line_utf8 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Reads a UTF-8 encoded line from the data input stream.
-- 
-- 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.
-- 
-- /Since: 2.30/
dataInputStreamReadLineUtf8 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ((Maybe T.Text, FCT.CSize))
    -- ^ __Returns:__ a NUL terminated UTF-8 string
    --  with the line that was read in (without the newlines).  Set
    --  /@length@/ to a @/gsize/@ to get the length of the read line.  On an
    --  error, it will return 'P.Nothing' and /@error@/ will be set.  For UTF-8
    --  conversion errors, the set error domain is @/G_CONVERT_ERROR/@.  If
    --  there\'s no content to read, it will still return 'P.Nothing', but /@error@/
    --  won\'t be set. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadLineUtf8 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m (Maybe Text, CSize)
dataInputStreamReadLineUtf8 a
stream Maybe b
cancellable = IO (Maybe Text, CSize) -> m (Maybe Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, CSize) -> m (Maybe Text, CSize))
-> IO (Maybe Text, CSize) -> m (Maybe Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_line_utf8 stream' length_ maybeCancellable
        maybeResult <- convertIfNonNull result $ \CString
result' -> do
            result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            freeMem result'
            return result''
        length_' <- peek length_
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        freeMem length_
        return (maybeResult, length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineUtf8MethodInfo
instance (signature ~ (Maybe (b) -> m ((Maybe T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadLineUtf8MethodInfo a signature where
    overloadedMethod = dataInputStreamReadLineUtf8

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


#endif

-- method DataInputStream::read_uint16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_uint16" g_data_input_stream_read_uint16 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Word16

-- | Reads an unsigned 16-bit\/2-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder' and 'GI.Gio.Objects.DataInputStream.dataInputStreamSetByteOrder'.
dataInputStreamReadUint16 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Word16
    -- ^ __Returns:__ an unsigned 16-bit\/2-byte value read from the /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUint16 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Word16
dataInputStreamReadUint16 a
stream Maybe b
cancellable = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_uint16 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUint16MethodInfo
instance (signature ~ (Maybe (b) -> m Word16), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUint16MethodInfo a signature where
    overloadedMethod = dataInputStreamReadUint16

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


#endif

-- method DataInputStream::read_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_uint32" g_data_input_stream_read_uint32 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Reads an unsigned 32-bit\/4-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder' and 'GI.Gio.Objects.DataInputStream.dataInputStreamSetByteOrder'.
-- 
-- 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.
dataInputStreamReadUint32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Word32
    -- ^ __Returns:__ an unsigned 32-bit\/4-byte value read from the /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUint32 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Word32
dataInputStreamReadUint32 a
stream Maybe b
cancellable = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_uint32 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUint32MethodInfo
instance (signature ~ (Maybe (b) -> m Word32), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUint32MethodInfo a signature where
    overloadedMethod = dataInputStreamReadUint32

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


#endif

-- method DataInputStream::read_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_uint64" g_data_input_stream_read_uint64 :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Word64

-- | Reads an unsigned 64-bit\/8-byte value from /@stream@/.
-- 
-- In order to get the correct byte order for this read operation,
-- see 'GI.Gio.Objects.DataInputStream.dataInputStreamGetByteOrder'.
-- 
-- 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.
dataInputStreamReadUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Word64
    -- ^ __Returns:__ an unsigned 64-bit\/8-byte read from /@stream@/ or @0@ if
    -- an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUint64 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Maybe b -> m Word64
dataInputStreamReadUint64 a
stream Maybe b
cancellable = IO Word64 -> m Word64
forall a. IO a -> m a
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
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_uint64 stream' maybeCancellable
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return result
     ) (do
        return ()
     )

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

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


#endif

-- method DataInputStream::read_until
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "characters to terminate the read."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_until" g_data_input_stream_read_until :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CString ->                              -- stop_chars : TBasicType TUTF8
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

{-# DEPRECATED dataInputStreamReadUntil ["(Since version 2.56)","Use 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUpto' instead, which has more","    consistent behaviour regarding the stop character."] #-}
-- | Reads a string from the data input stream, up to the first
-- occurrence of any of the stop characters.
-- 
-- Note that, in contrast to 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntilAsync',
-- this function consumes the stop character that it finds.
-- 
-- Don\'t use this function in new code.  Its functionality is
-- inconsistent with 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntilAsync'.  Both
-- functions will be marked as deprecated in a future release.  Use
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUpto' instead, but note that that function
-- does not consume the stop character.
dataInputStreamReadUntil ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> T.Text
    -- ^ /@stopChars@/: characters to terminate the read.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ((T.Text, FCT.CSize))
    -- ^ __Returns:__ a string with the data that was read
    --     before encountering any of the stop characters. Set /@length@/ to
    --     a @/gsize/@ to get the length of the string. This function will
    --     return 'P.Nothing' on an error. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUntil :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Text -> Maybe b -> m (Text, CSize)
dataInputStreamReadUntil a
stream Text
stopChars Maybe b
cancellable = IO (Text, CSize) -> m (Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, CSize) -> m (Text, CSize))
-> IO (Text, CSize) -> m (Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    stopChars' <- textToCString stopChars
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_until stream' stopChars' length_ maybeCancellable
        checkUnexpectedReturnNULL "dataInputStreamReadUntil" result
        result' <- cstringToText result
        freeMem result
        length_' <- peek length_
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        freeMem stopChars'
        freeMem length_
        return (result', length_')
     ) (do
        freeMem stopChars'
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUntilMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ((T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUntilMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUntil

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


#endif

-- method DataInputStream::read_until_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "characters to terminate the read."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_read_until_async" g_data_input_stream_read_until_async :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CString ->                              -- stop_chars : TBasicType TUTF8
    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 ()

{-# DEPRECATED dataInputStreamReadUntilAsync ["(Since version 2.56)","Use 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoAsync' instead, which","    has more consistent behaviour regarding the stop character."] #-}
-- | The asynchronous version of 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntil'.
-- It is an error to have two outstanding calls to this function.
-- 
-- Note that, in contrast to 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntil',
-- this function does not consume the stop character that it finds.  You
-- must read it for yourself.
-- 
-- When the operation is finished, /@callback@/ will be called. You
-- can then call 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntilFinish' to get
-- the result of the operation.
-- 
-- Don\'t use this function in new code.  Its functionality is
-- inconsistent with 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntil'.  Both functions
-- will be marked as deprecated in a future release.  Use
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoAsync' instead.
-- 
-- /Since: 2.20/
dataInputStreamReadUntilAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> T.Text
    -- ^ /@stopChars@/: characters to terminate the read.
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][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 ()
dataInputStreamReadUntilAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dataInputStreamReadUntilAsync a
stream Text
stopChars Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    stopChars' <- textToCString stopChars
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_data_input_stream_read_until_async stream' stopChars' ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr stream
    whenJust cancellable touchManagedPtr
    freeMem stopChars'
    return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUntilAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUntilAsyncMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUntilAsync

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


#endif

-- method DataInputStream::read_until_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult that was provided to the callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_until_finish" g_data_input_stream_read_until_finish :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr (Ptr GError) ->                     -- error
    IO CString

{-# DEPRECATED dataInputStreamReadUntilFinish ["(Since version 2.56)","Use 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoFinish' instead, which","    has more consistent behaviour regarding the stop character."] #-}
-- | Finish an asynchronous call started by
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntilAsync'.
-- 
-- /Since: 2.20/
dataInputStreamReadUntilFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' that was provided to the callback.
    -> m ((T.Text, FCT.CSize))
    -- ^ __Returns:__ a string with the data that was read
    --     before encountering any of the stop characters. Set /@length@/ to
    --     a @/gsize/@ to get the length of the string. This function will
    --     return 'P.Nothing' on an error. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUntilFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsAsyncResult b) =>
a -> b -> m (Text, CSize)
dataInputStreamReadUntilFinish a
stream b
result_ = IO (Text, CSize) -> m (Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, CSize) -> m (Text, CSize))
-> IO (Text, CSize) -> m (Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result_' <- unsafeManagedPtrCastPtr result_
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    onException (do
        result <- propagateGError $ g_data_input_stream_read_until_finish stream' result_' length_
        checkUnexpectedReturnNULL "dataInputStreamReadUntilFinish" result
        result' <- cstringToText result
        freeMem result
        length_' <- peek length_
        touchManagedPtr stream
        touchManagedPtr result_
        freeMem length_
        return (result', length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUntilFinishMethodInfo
instance (signature ~ (b -> m ((T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DataInputStreamReadUntilFinishMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUntilFinish

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


#endif

-- method DataInputStream::read_upto
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataInputStream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "characters to terminate the read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars_len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "length of @stop_chars. May be -1 if @stop_chars is\n    nul-terminated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_upto" g_data_input_stream_read_upto :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CString ->                              -- stop_chars : TBasicType TUTF8
    DI.Int64 ->                             -- stop_chars_len : TBasicType TSSize
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Reads a string from the data input stream, up to the first
-- occurrence of any of the stop characters.
-- 
-- In contrast to 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntil', this function
-- does not consume the stop character. You have to use
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadByte' to get it before calling
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUpto' again.
-- 
-- Note that /@stopChars@/ may contain \'\\0\' if /@stopCharsLen@/ is
-- specified.
-- 
-- The returned string will always be nul-terminated on success.
-- 
-- /Since: 2.26/
dataInputStreamReadUpto ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataInputStream.DataInputStream'
    -> T.Text
    -- ^ /@stopChars@/: characters to terminate the read
    -> DI.Int64
    -- ^ /@stopCharsLen@/: length of /@stopChars@/. May be -1 if /@stopChars@/ is
    --     nul-terminated
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m ((T.Text, FCT.CSize))
    -- ^ __Returns:__ a string with the data that was read
    --     before encountering any of the stop characters. Set /@length@/ to
    --     a @/gsize/@ to get the length of the string. This function will
    --     return 'P.Nothing' on an error /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUpto :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a -> Text -> Int64 -> Maybe b -> m (Text, CSize)
dataInputStreamReadUpto a
stream Text
stopChars Int64
stopCharsLen Maybe b
cancellable = IO (Text, CSize) -> m (Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, CSize) -> m (Text, CSize))
-> IO (Text, CSize) -> m (Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    stopChars' <- textToCString stopChars
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_data_input_stream_read_upto stream' stopChars' stopCharsLen length_ maybeCancellable
        checkUnexpectedReturnNULL "dataInputStreamReadUpto" result
        result' <- cstringToText result
        freeMem result
        length_' <- peek length_
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        freeMem stopChars'
        freeMem length_
        return (result', length_')
     ) (do
        freeMem stopChars'
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoMethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> Maybe (b) -> m ((T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUptoMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUpto

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


#endif

-- method DataInputStream::read_upto_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataInputStream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "characters to terminate the read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars_len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "length of @stop_chars. May be -1 if @stop_chars is\n    nul-terminated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_read_upto_async" g_data_input_stream_read_upto_async :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CString ->                              -- stop_chars : TBasicType TUTF8
    DI.Int64 ->                             -- stop_chars_len : TBasicType TSSize
    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 ()

-- | The asynchronous version of 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUpto'.
-- It is an error to have two outstanding calls to this function.
-- 
-- In contrast to 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUntil', this function
-- does not consume the stop character. You have to use
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadByte' to get it before calling
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUpto' again.
-- 
-- Note that /@stopChars@/ may contain \'\\0\' if /@stopCharsLen@/ is
-- specified.
-- 
-- When the operation is finished, /@callback@/ will be called. You
-- can then call 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.26/
dataInputStreamReadUptoAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataInputStream.DataInputStream'
    -> T.Text
    -- ^ /@stopChars@/: characters to terminate the read
    -> DI.Int64
    -- ^ /@stopCharsLen@/: length of /@stopChars@/. May be -1 if /@stopChars@/ is
    --     nul-terminated
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][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 ()
dataInputStreamReadUptoAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsCancellable b) =>
a
-> Text
-> Int64
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
dataInputStreamReadUptoAsync a
stream Text
stopChars Int64
stopCharsLen Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    stopChars' <- textToCString stopChars
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_data_input_stream_read_upto_async stream' stopChars' stopCharsLen ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr stream
    whenJust cancellable touchManagedPtr
    freeMem stopChars'
    return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoAsyncMethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DataInputStreamReadUptoAsyncMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUptoAsync

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


#endif

-- method DataInputStream::read_upto_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataInputStream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult that was provided to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gsize to get the length of the data read in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_input_stream_read_upto_finish" g_data_input_stream_read_upto_finish :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Finish an asynchronous call started by
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoAsync'.
-- 
-- Note that this function does not consume the stop character. You
-- have to use 'GI.Gio.Objects.DataInputStream.dataInputStreamReadByte' to get it before calling
-- 'GI.Gio.Objects.DataInputStream.dataInputStreamReadUptoAsync' again.
-- 
-- The returned string will always be nul-terminated on success.
-- 
-- /Since: 2.24/
dataInputStreamReadUptoFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataInputStream.DataInputStream'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' that was provided to the callback
    -> m ((T.Text, FCT.CSize))
    -- ^ __Returns:__ a string with the data that was read
    --     before encountering any of the stop characters. Set /@length@/ to
    --     a @/gsize/@ to get the length of the string. This function will
    --     return 'P.Nothing' on an error. /(Can throw 'Data.GI.Base.GError.GError')/
dataInputStreamReadUptoFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDataInputStream a, IsAsyncResult b) =>
a -> b -> m (Text, CSize)
dataInputStreamReadUptoFinish a
stream b
result_ = IO (Text, CSize) -> m (Text, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, CSize) -> m (Text, CSize))
-> IO (Text, CSize) -> m (Text, CSize)
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    result_' <- unsafeManagedPtrCastPtr result_
    length_ <- allocMem :: IO (Ptr FCT.CSize)
    onException (do
        result <- propagateGError $ g_data_input_stream_read_upto_finish stream' result_' length_
        checkUnexpectedReturnNULL "dataInputStreamReadUptoFinish" result
        result' <- cstringToText result
        freeMem result
        length_' <- peek length_
        touchManagedPtr stream
        touchManagedPtr result_
        freeMem length_
        return (result', length_')
     ) (do
        freeMem length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoFinishMethodInfo
instance (signature ~ (b -> m ((T.Text, FCT.CSize))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DataInputStreamReadUptoFinishMethodInfo a signature where
    overloadedMethod = dataInputStreamReadUptoFinish

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


#endif

-- method DataInputStream::set_byte_order
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "order"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DataStreamByteOrder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataStreamByteOrder to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_set_byte_order" g_data_input_stream_set_byte_order :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CUInt ->                                -- order : TInterface (Name {namespace = "Gio", name = "DataStreamByteOrder"})
    IO ()

-- | This function sets the byte order for the given /@stream@/. All subsequent
-- reads from the /@stream@/ will be read in the given /@order@/.
dataInputStreamSetByteOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a) =>
    a
    -- ^ /@stream@/: a given t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Gio.Enums.DataStreamByteOrder
    -- ^ /@order@/: a t'GI.Gio.Enums.DataStreamByteOrder' to set.
    -> m ()
dataInputStreamSetByteOrder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDataInputStream a) =>
a -> DataStreamByteOrder -> m ()
dataInputStreamSetByteOrder a
stream DataStreamByteOrder
order = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let order' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (DataStreamByteOrder -> Int) -> DataStreamByteOrder -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataStreamByteOrder -> Int
forall a. Enum a => a -> Int
fromEnum) DataStreamByteOrder
order
    g_data_input_stream_set_byte_order stream' order'
    touchManagedPtr stream
    return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamSetByteOrderMethodInfo
instance (signature ~ (Gio.Enums.DataStreamByteOrder -> m ()), MonadIO m, IsDataInputStream a) => O.OverloadedMethod DataInputStreamSetByteOrderMethodInfo a signature where
    overloadedMethod = dataInputStreamSetByteOrder

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


#endif

-- method DataInputStream::set_newline_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DataStreamNewlineType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the type of new line return as #GDataStreamNewlineType."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_data_input_stream_set_newline_type" g_data_input_stream_set_newline_type :: 
    Ptr DataInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "DataInputStream"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "DataStreamNewlineType"})
    IO ()

-- | Sets the newline type for the /@stream@/.
-- 
-- Note that using G_DATA_STREAM_NEWLINE_TYPE_ANY is slightly unsafe. If a read
-- chunk ends in \"CR\" we must read an additional byte to know if this is \"CR\" or
-- \"CR LF\", and this might block if there is no more data available.
dataInputStreamSetNewlineType ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataInputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataInputStream.DataInputStream'.
    -> Gio.Enums.DataStreamNewlineType
    -- ^ /@type@/: the type of new line return as t'GI.Gio.Enums.DataStreamNewlineType'.
    -> m ()
dataInputStreamSetNewlineType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDataInputStream a) =>
a -> DataStreamNewlineType -> m ()
dataInputStreamSetNewlineType a
stream DataStreamNewlineType
type_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (DataStreamNewlineType -> Int) -> DataStreamNewlineType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataStreamNewlineType -> Int
forall a. Enum a => a -> Int
fromEnum) DataStreamNewlineType
type_
    g_data_input_stream_set_newline_type stream' type_'
    touchManagedPtr stream
    return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamSetNewlineTypeMethodInfo
instance (signature ~ (Gio.Enums.DataStreamNewlineType -> m ()), MonadIO m, IsDataInputStream a) => O.OverloadedMethod DataInputStreamSetNewlineTypeMethodInfo a signature where
    overloadedMethod = dataInputStreamSetNewlineType

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


#endif