{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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
-- ** Overloaded methods #method:Overloaded methods#

#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#
-- | /No description available in the introspection data./

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


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

#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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.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

-- | 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
/= :: DataInputStream -> DataInputStream -> Bool
$c/= :: DataInputStream -> DataInputStream -> Bool
== :: DataInputStream -> DataInputStream -> Bool
$c== :: 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

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

-- | 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 :: (MonadIO m, IsDataInputStream o) => o -> m DataInputStream
toDataInputStream :: o -> m DataInputStream
toDataInputStream = IO DataInputStream -> m DataInputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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'
unsafeCastTo ManagedPtr DataInputStream -> DataInputStream
DataInputStream

#if defined(ENABLE_OVERLOADING)
type family ResolveDataInputStreamMethod (t :: Symbol) (o :: *) :: * 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.MethodInfo 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

#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 :: o -> m DataStreamByteOrder
getDataInputStreamByteOrder o
obj = IO DataStreamByteOrder -> m DataStreamByteOrder
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
$ 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 :: o -> DataStreamByteOrder -> m ()
setDataInputStreamByteOrder o
obj DataStreamByteOrder
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 :: DataStreamByteOrder -> m (GValueConstruct o)
constructDataInputStreamByteOrder DataStreamByteOrder
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ 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
#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 :: o -> m DataStreamNewlineType
getDataInputStreamNewlineType o
obj = IO DataStreamNewlineType -> m DataStreamNewlineType
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
$ 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 :: o -> DataStreamNewlineType -> m ()
setDataInputStreamNewlineType o
obj DataStreamNewlineType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 :: DataStreamNewlineType -> m (GValueConstruct o)
constructDataInputStreamNewlineType DataStreamNewlineType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ 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
#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, *)])
#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, *)])

#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
--           , 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 :: a -> m DataInputStream
dataInputStreamNew a
baseStream = IO DataInputStream -> m DataInputStream
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
    Ptr InputStream
baseStream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseStream
    Ptr DataInputStream
result <- Ptr InputStream -> IO (Ptr DataInputStream)
g_data_input_stream_new Ptr InputStream
baseStream'
    Text -> Ptr DataInputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dataInputStreamNew" Ptr DataInputStream
result
    DataInputStream
result' <- ((ManagedPtr DataInputStream -> DataInputStream)
-> Ptr DataInputStream -> IO DataInputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DataInputStream -> DataInputStream
DataInputStream) Ptr DataInputStream
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseStream
    DataInputStream -> IO DataInputStream
forall (m :: * -> *) a. Monad m => a -> m a
return DataInputStream
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
--           , 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 :: a -> m DataStreamByteOrder
dataInputStreamGetByteOrder a
stream = IO DataStreamByteOrder -> m DataStreamByteOrder
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CUInt
result <- Ptr DataInputStream -> IO CUInt
g_data_input_stream_get_byte_order Ptr DataInputStream
stream'
    let result' :: DataStreamByteOrder
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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    DataStreamByteOrder -> IO DataStreamByteOrder
forall (m :: * -> *) a. Monad m => a -> m a
return DataStreamByteOrder
result'

#if defined(ENABLE_OVERLOADING)
data DataInputStreamGetByteOrderMethodInfo
instance (signature ~ (m Gio.Enums.DataStreamByteOrder), MonadIO m, IsDataInputStream a) => O.MethodInfo DataInputStreamGetByteOrderMethodInfo a signature where
    overloadedMethod = 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
--           , 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 :: a -> m DataStreamNewlineType
dataInputStreamGetNewlineType a
stream = IO DataStreamNewlineType -> m DataStreamNewlineType
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CUInt
result <- Ptr DataInputStream -> IO CUInt
g_data_input_stream_get_newline_type Ptr DataInputStream
stream'
    let result' :: DataStreamNewlineType
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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    DataStreamNewlineType -> IO DataStreamNewlineType
forall (m :: * -> *) a. Monad m => a -> m a
return DataStreamNewlineType
result'

#if defined(ENABLE_OVERLOADING)
data DataInputStreamGetNewlineTypeMethodInfo
instance (signature ~ (m Gio.Enums.DataStreamNewlineType), MonadIO m, IsDataInputStream a) => O.MethodInfo DataInputStreamGetNewlineTypeMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Word8
dataInputStreamReadByte a
stream Maybe b
cancellable = IO Word8 -> m Word8
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word8 -> IO () -> IO Word8
forall a b. IO a -> IO b -> IO a
onException (do
        Word8
result <- (Ptr (Ptr GError) -> IO Word8) -> IO Word8
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word8) -> IO Word8)
-> (Ptr (Ptr GError) -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Word8
g_data_input_stream_read_byte Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadByteMethodInfo
instance (signature ~ (Maybe (b) -> m Word8), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadByteMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Int16
dataInputStreamReadInt16 a
stream Maybe b
cancellable = IO Int16 -> m Int16
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int16 -> IO () -> IO Int16
forall a b. IO a -> IO b -> IO a
onException (do
        Int16
result <- (Ptr (Ptr GError) -> IO Int16) -> IO Int16
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int16) -> IO Int16)
-> (Ptr (Ptr GError) -> IO Int16) -> IO Int16
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Int16
g_data_input_stream_read_int16 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Int16 -> IO Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadInt16MethodInfo
instance (signature ~ (Maybe (b) -> m Int16), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadInt16MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Int32
dataInputStreamReadInt32 a
stream Maybe b
cancellable = IO Int32 -> m Int32
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Int32
g_data_input_stream_read_int32 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadInt32MethodInfo
instance (signature ~ (Maybe (b) -> m Int32), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadInt32MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "g_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 :: a -> Maybe b -> m Int64
dataInputStreamReadInt64 a
stream Maybe b
cancellable = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Int64
g_data_input_stream_read_int64 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadInt64MethodInfo
instance (signature ~ (Maybe (b) -> m Int64), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadInt64MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> Maybe b -> m (Maybe ByteString, Word64)
dataInputStreamReadLine a
stream Maybe b
cancellable = IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64))
-> IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe ByteString, Word64)
-> IO () -> IO (Maybe ByteString, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Word8
result <- (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Word8)
g_data_input_stream_read_line Ptr DataInputStream
stream' Ptr Word64
length_ Ptr Cancellable
maybeCancellable
        Maybe ByteString
maybeResult <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
result ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result' -> do
            ByteString
result'' <- Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString Ptr Word8
result'
            Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result'
            ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Maybe ByteString, Word64) -> IO (Maybe ByteString, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
maybeResult, Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineMethodInfo
instance (signature ~ (Maybe (b) -> m ((Maybe ByteString, Word64))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadLineMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_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 :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dataInputStreamReadLineAsync a
stream Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr DataInputStream
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_data_input_stream_read_line_async Ptr DataInputStream
stream' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadLineAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> b -> m (Maybe ByteString, Word64)
dataInputStreamReadLineFinish a
stream b
result_ = IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64))
-> IO (Maybe ByteString, Word64) -> m (Maybe ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (Maybe ByteString, Word64)
-> IO () -> IO (Maybe ByteString, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Word8
result <- (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr AsyncResult
-> Ptr Word64
-> Ptr (Ptr GError)
-> IO (Ptr Word8)
g_data_input_stream_read_line_finish Ptr DataInputStream
stream' Ptr AsyncResult
result_' Ptr Word64
length_
        Maybe ByteString
maybeResult <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
result ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result' -> do
            ByteString
result'' <- Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString Ptr Word8
result'
            Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result'
            ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Maybe ByteString, Word64) -> IO (Maybe ByteString, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
maybeResult, Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineFinishMethodInfo
instance (signature ~ (b -> m ((Maybe ByteString, Word64))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo DataInputStreamReadLineFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> b -> m (Maybe Text, Word64)
dataInputStreamReadLineFinishUtf8 a
stream b
result_ = IO (Maybe Text, Word64) -> m (Maybe Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, Word64) -> m (Maybe Text, Word64))
-> IO (Maybe Text, Word64) -> m (Maybe Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (Maybe Text, Word64) -> IO () -> IO (Maybe Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CString
g_data_input_stream_read_line_finish_utf8 Ptr DataInputStream
stream' Ptr AsyncResult
result_' Ptr Word64
length_
        Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
            Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Maybe Text, Word64) -> IO (Maybe Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeResult, Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineFinishUtf8MethodInfo
instance (signature ~ (b -> m ((Maybe T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo DataInputStreamReadLineFinishUtf8MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> Maybe b -> m (Maybe Text, Word64)
dataInputStreamReadLineUtf8 a
stream Maybe b
cancellable = IO (Maybe Text, Word64) -> m (Maybe Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, Word64) -> m (Maybe Text, Word64))
-> IO (Maybe Text, Word64) -> m (Maybe Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe Text, Word64) -> IO () -> IO (Maybe Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Word64 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CString
g_data_input_stream_read_line_utf8 Ptr DataInputStream
stream' Ptr Word64
length_ Ptr Cancellable
maybeCancellable
        Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
            Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Maybe Text, Word64) -> IO (Maybe Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeResult, Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadLineUtf8MethodInfo
instance (signature ~ (Maybe (b) -> m ((Maybe T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadLineUtf8MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Word16
dataInputStreamReadUint16 a
stream Maybe b
cancellable = IO Word16 -> m Word16
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word16 -> IO () -> IO Word16
forall a b. IO a -> IO b -> IO a
onException (do
        Word16
result <- (Ptr (Ptr GError) -> IO Word16) -> IO Word16
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word16) -> IO Word16)
-> (Ptr (Ptr GError) -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Word16
g_data_input_stream_read_uint16 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUint16MethodInfo
instance (signature ~ (Maybe (b) -> m Word16), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUint16MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Word32
dataInputStreamReadUint32 a
stream Maybe b
cancellable = IO Word32 -> m Word32
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
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Word32
g_data_input_stream_read_uint32 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUint32MethodInfo
instance (signature ~ (Maybe (b) -> m Word32), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUint32MethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType 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 :: a -> Maybe b -> m Word64
dataInputStreamReadUint64 a
stream Maybe b
cancellable = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word64 -> IO () -> IO Word64
forall a b. IO a -> IO b -> IO a
onException (do
        Word64
result <- (Ptr (Ptr GError) -> IO Word64) -> IO Word64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word64) -> IO Word64)
-> (Ptr (Ptr GError) -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO Word64
g_data_input_stream_read_uint64 Ptr DataInputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUint64MethodInfo
instance (signature ~ (Maybe (b) -> m Word64), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUint64MethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> Text -> Maybe b -> m (Text, Word64)
dataInputStreamReadUntil a
stream Text
stopChars Maybe b
cancellable = IO (Text, Word64) -> m (Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Word64) -> m (Text, Word64))
-> IO (Text, Word64) -> m (Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
stopChars' <- Text -> IO CString
textToCString Text
stopChars
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Text, Word64) -> IO () -> IO (Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> CString
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CString
g_data_input_stream_read_until Ptr DataInputStream
stream' CString
stopChars' Ptr Word64
length_ Ptr Cancellable
maybeCancellable
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dataInputStreamReadUntil" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Text, Word64) -> IO (Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
result', Word64
length_')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUntilMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ((T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUntilMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_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 :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dataInputStreamReadUntilAsync a
stream Text
stopChars Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
stopChars' <- Text -> IO CString
textToCString Text
stopChars
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr DataInputStream
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_data_input_stream_read_until_async Ptr DataInputStream
stream' CString
stopChars' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo DataInputStreamReadUntilAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> b -> m (Text, Word64)
dataInputStreamReadUntilFinish a
stream b
result_ = IO (Text, Word64) -> m (Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Word64) -> m (Text, Word64))
-> IO (Text, Word64) -> m (Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (Text, Word64) -> IO () -> IO (Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CString
g_data_input_stream_read_until_finish Ptr DataInputStream
stream' Ptr AsyncResult
result_' Ptr Word64
length_
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dataInputStreamReadUntilFinish" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Text, Word64) -> IO (Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
result', Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUntilFinishMethodInfo
instance (signature ~ (b -> m ((T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo DataInputStreamReadUntilFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars_len"
--           , argType = TBasicType TInt64
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- 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
    Int64 ->                                -- stop_chars_len : TBasicType TInt64
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    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
    -> 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, Word64))
    -- ^ __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 :: a -> Text -> Int64 -> Maybe b -> m (Text, Word64)
dataInputStreamReadUpto a
stream Text
stopChars Int64
stopCharsLen Maybe b
cancellable = IO (Text, Word64) -> m (Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Word64) -> m (Text, Word64))
-> IO (Text, Word64) -> m (Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
stopChars' <- Text -> IO CString
textToCString Text
stopChars
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Text, Word64) -> IO () -> IO (Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> CString
-> Int64
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CString
g_data_input_stream_read_upto Ptr DataInputStream
stream' CString
stopChars' Int64
stopCharsLen Ptr Word64
length_ Ptr Cancellable
maybeCancellable
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dataInputStreamReadUpto" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Text, Word64) -> IO (Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
result', Word64
length_')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoMethodInfo
instance (signature ~ (T.Text -> Int64 -> Maybe (b) -> m ((T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUptoMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_chars_len"
--           , argType = TBasicType TInt64
--           , 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "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
    Int64 ->                                -- stop_chars_len : TBasicType TInt64
    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
    -> 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 :: 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
stopChars' <- Text -> IO CString
textToCString Text
stopChars
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr DataInputStream
-> CString
-> Int64
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_data_input_stream_read_upto_async Ptr DataInputStream
stream' CString
stopChars' Int64
stopCharsLen Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stopChars'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoAsyncMethodInfo
instance (signature ~ (T.Text -> Int64 -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDataInputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataInputStreamReadUptoAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , 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
--           , 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 Word64 ->                           -- length : TBasicType TUInt64
    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, Word64))
    -- ^ __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 :: a -> b -> m (Text, Word64)
dataInputStreamReadUptoFinish a
stream b
result_ = IO (Text, Word64) -> m (Text, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Word64) -> m (Text, Word64))
-> IO (Text, Word64) -> m (Text, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (Text, Word64) -> IO () -> IO (Text, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr DataInputStream
-> Ptr AsyncResult -> Ptr Word64 -> Ptr (Ptr GError) -> IO CString
g_data_input_stream_read_upto_finish Ptr DataInputStream
stream' Ptr AsyncResult
result_' Ptr Word64
length_
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dataInputStreamReadUptoFinish" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (Text, Word64) -> IO (Text, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
result', Word64
length_')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data DataInputStreamReadUptoFinishMethodInfo
instance (signature ~ (b -> m ((T.Text, Word64))), MonadIO m, IsDataInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo DataInputStreamReadUptoFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 :: a -> DataStreamByteOrder -> m ()
dataInputStreamSetByteOrder a
stream DataStreamByteOrder
order = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let order' :: CUInt
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
    Ptr DataInputStream -> CUInt -> IO ()
g_data_input_stream_set_byte_order Ptr DataInputStream
stream' CUInt
order'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DataInputStreamSetByteOrderMethodInfo
instance (signature ~ (Gio.Enums.DataStreamByteOrder -> m ()), MonadIO m, IsDataInputStream a) => O.MethodInfo DataInputStreamSetByteOrderMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 :: a -> DataStreamNewlineType -> m ()
dataInputStreamSetNewlineType a
stream DataStreamNewlineType
type_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataInputStream
stream' <- a -> IO (Ptr DataInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let type_' :: CUInt
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_
    Ptr DataInputStream -> CUInt -> IO ()
g_data_input_stream_set_newline_type Ptr DataInputStream
stream' CUInt
type_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif