{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Data output stream implements t'GI.Gio.Objects.OutputStream.OutputStream' and includes functions for
-- writing data directly to an output stream.

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

module GI.Gio.Objects.DataOutputStream
    ( 

-- * Exported types
    DataOutputStream(..)                    ,
    IsDataOutputStream                      ,
    toDataOutputStream                      ,
    noDataOutputStream                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDataOutputStreamMethod           ,
#endif


-- ** getByteOrder #method:getByteOrder#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamGetByteOrderMethodInfo  ,
#endif
    dataOutputStreamGetByteOrder            ,


-- ** new #method:new#

    dataOutputStreamNew                     ,


-- ** putByte #method:putByte#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutByteMethodInfo       ,
#endif
    dataOutputStreamPutByte                 ,


-- ** putInt16 #method:putInt16#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutInt16MethodInfo      ,
#endif
    dataOutputStreamPutInt16                ,


-- ** putInt32 #method:putInt32#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutInt32MethodInfo      ,
#endif
    dataOutputStreamPutInt32                ,


-- ** putInt64 #method:putInt64#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutInt64MethodInfo      ,
#endif
    dataOutputStreamPutInt64                ,


-- ** putString #method:putString#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutStringMethodInfo     ,
#endif
    dataOutputStreamPutString               ,


-- ** putUint16 #method:putUint16#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutUint16MethodInfo     ,
#endif
    dataOutputStreamPutUint16               ,


-- ** putUint32 #method:putUint32#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutUint32MethodInfo     ,
#endif
    dataOutputStreamPutUint32               ,


-- ** putUint64 #method:putUint64#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamPutUint64MethodInfo     ,
#endif
    dataOutputStreamPutUint64               ,


-- ** setByteOrder #method:setByteOrder#

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamSetByteOrderMethodInfo  ,
#endif
    dataOutputStreamSetByteOrder            ,




 -- * Properties
-- ** byteOrder #attr:byteOrder#
-- | Determines the byte ordering that is used when writing
-- multi-byte entities (such as integers) to the stream.

#if defined(ENABLE_OVERLOADING)
    DataOutputStreamByteOrderPropertyInfo   ,
#endif
    constructDataOutputStreamByteOrder      ,
#if defined(ENABLE_OVERLOADING)
    dataOutputStreamByteOrder               ,
#endif
    getDataOutputStreamByteOrder            ,
    setDataOutputStreamByteOrder            ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Seekable as Gio.Seekable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FilterOutputStream as Gio.FilterOutputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.OutputStream as Gio.OutputStream

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

instance GObject DataOutputStream where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_data_output_stream_get_type
    

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

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

instance O.HasParentTypes DataOutputStream
type instance O.ParentTypes DataOutputStream = '[Gio.FilterOutputStream.FilterOutputStream, Gio.OutputStream.OutputStream, GObject.Object.Object, Gio.Seekable.Seekable]

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

-- | A convenience alias for `Nothing` :: `Maybe` `DataOutputStream`.
noDataOutputStream :: Maybe DataOutputStream
noDataOutputStream :: Maybe DataOutputStream
noDataOutputStream = Maybe DataOutputStream
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveDataOutputStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveDataOutputStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDataOutputStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDataOutputStreamMethod "canSeek" o = Gio.Seekable.SeekableCanSeekMethodInfo
    ResolveDataOutputStreamMethod "canTruncate" o = Gio.Seekable.SeekableCanTruncateMethodInfo
    ResolveDataOutputStreamMethod "clearPending" o = Gio.OutputStream.OutputStreamClearPendingMethodInfo
    ResolveDataOutputStreamMethod "close" o = Gio.OutputStream.OutputStreamCloseMethodInfo
    ResolveDataOutputStreamMethod "closeAsync" o = Gio.OutputStream.OutputStreamCloseAsyncMethodInfo
    ResolveDataOutputStreamMethod "closeFinish" o = Gio.OutputStream.OutputStreamCloseFinishMethodInfo
    ResolveDataOutputStreamMethod "flush" o = Gio.OutputStream.OutputStreamFlushMethodInfo
    ResolveDataOutputStreamMethod "flushAsync" o = Gio.OutputStream.OutputStreamFlushAsyncMethodInfo
    ResolveDataOutputStreamMethod "flushFinish" o = Gio.OutputStream.OutputStreamFlushFinishMethodInfo
    ResolveDataOutputStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDataOutputStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDataOutputStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDataOutputStreamMethod "hasPending" o = Gio.OutputStream.OutputStreamHasPendingMethodInfo
    ResolveDataOutputStreamMethod "isClosed" o = Gio.OutputStream.OutputStreamIsClosedMethodInfo
    ResolveDataOutputStreamMethod "isClosing" o = Gio.OutputStream.OutputStreamIsClosingMethodInfo
    ResolveDataOutputStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDataOutputStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDataOutputStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDataOutputStreamMethod "putByte" o = DataOutputStreamPutByteMethodInfo
    ResolveDataOutputStreamMethod "putInt16" o = DataOutputStreamPutInt16MethodInfo
    ResolveDataOutputStreamMethod "putInt32" o = DataOutputStreamPutInt32MethodInfo
    ResolveDataOutputStreamMethod "putInt64" o = DataOutputStreamPutInt64MethodInfo
    ResolveDataOutputStreamMethod "putString" o = DataOutputStreamPutStringMethodInfo
    ResolveDataOutputStreamMethod "putUint16" o = DataOutputStreamPutUint16MethodInfo
    ResolveDataOutputStreamMethod "putUint32" o = DataOutputStreamPutUint32MethodInfo
    ResolveDataOutputStreamMethod "putUint64" o = DataOutputStreamPutUint64MethodInfo
    ResolveDataOutputStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDataOutputStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDataOutputStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDataOutputStreamMethod "seek" o = Gio.Seekable.SeekableSeekMethodInfo
    ResolveDataOutputStreamMethod "splice" o = Gio.OutputStream.OutputStreamSpliceMethodInfo
    ResolveDataOutputStreamMethod "spliceAsync" o = Gio.OutputStream.OutputStreamSpliceAsyncMethodInfo
    ResolveDataOutputStreamMethod "spliceFinish" o = Gio.OutputStream.OutputStreamSpliceFinishMethodInfo
    ResolveDataOutputStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDataOutputStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDataOutputStreamMethod "tell" o = Gio.Seekable.SeekableTellMethodInfo
    ResolveDataOutputStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDataOutputStreamMethod "truncate" o = Gio.Seekable.SeekableTruncateMethodInfo
    ResolveDataOutputStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDataOutputStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDataOutputStreamMethod "write" o = Gio.OutputStream.OutputStreamWriteMethodInfo
    ResolveDataOutputStreamMethod "writeAll" o = Gio.OutputStream.OutputStreamWriteAllMethodInfo
    ResolveDataOutputStreamMethod "writeAllAsync" o = Gio.OutputStream.OutputStreamWriteAllAsyncMethodInfo
    ResolveDataOutputStreamMethod "writeAllFinish" o = Gio.OutputStream.OutputStreamWriteAllFinishMethodInfo
    ResolveDataOutputStreamMethod "writeAsync" o = Gio.OutputStream.OutputStreamWriteAsyncMethodInfo
    ResolveDataOutputStreamMethod "writeBytes" o = Gio.OutputStream.OutputStreamWriteBytesMethodInfo
    ResolveDataOutputStreamMethod "writeBytesAsync" o = Gio.OutputStream.OutputStreamWriteBytesAsyncMethodInfo
    ResolveDataOutputStreamMethod "writeBytesFinish" o = Gio.OutputStream.OutputStreamWriteBytesFinishMethodInfo
    ResolveDataOutputStreamMethod "writeFinish" o = Gio.OutputStream.OutputStreamWriteFinishMethodInfo
    ResolveDataOutputStreamMethod "writev" o = Gio.OutputStream.OutputStreamWritevMethodInfo
    ResolveDataOutputStreamMethod "writevAll" o = Gio.OutputStream.OutputStreamWritevAllMethodInfo
    ResolveDataOutputStreamMethod "writevAllAsync" o = Gio.OutputStream.OutputStreamWritevAllAsyncMethodInfo
    ResolveDataOutputStreamMethod "writevAllFinish" o = Gio.OutputStream.OutputStreamWritevAllFinishMethodInfo
    ResolveDataOutputStreamMethod "writevAsync" o = Gio.OutputStream.OutputStreamWritevAsyncMethodInfo
    ResolveDataOutputStreamMethod "writevFinish" o = Gio.OutputStream.OutputStreamWritevFinishMethodInfo
    ResolveDataOutputStreamMethod "getBaseStream" o = Gio.FilterOutputStream.FilterOutputStreamGetBaseStreamMethodInfo
    ResolveDataOutputStreamMethod "getByteOrder" o = DataOutputStreamGetByteOrderMethodInfo
    ResolveDataOutputStreamMethod "getCloseBaseStream" o = Gio.FilterOutputStream.FilterOutputStreamGetCloseBaseStreamMethodInfo
    ResolveDataOutputStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDataOutputStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDataOutputStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDataOutputStreamMethod "setByteOrder" o = DataOutputStreamSetByteOrderMethodInfo
    ResolveDataOutputStreamMethod "setCloseBaseStream" o = Gio.FilterOutputStream.FilterOutputStreamSetCloseBaseStreamMethodInfo
    ResolveDataOutputStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDataOutputStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDataOutputStreamMethod "setPending" o = Gio.OutputStream.OutputStreamSetPendingMethodInfo
    ResolveDataOutputStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDataOutputStreamMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDataOutputStreamMethod t DataOutputStream, O.MethodInfo info DataOutputStream p) => OL.IsLabel t (DataOutputStream -> 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' dataOutputStream #byteOrder
-- @
getDataOutputStreamByteOrder :: (MonadIO m, IsDataOutputStream o) => o -> m Gio.Enums.DataStreamByteOrder
getDataOutputStreamByteOrder :: o -> m DataStreamByteOrder
getDataOutputStreamByteOrder obj :: 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 "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' dataOutputStream [ #byteOrder 'Data.GI.Base.Attributes.:=' value ]
-- @
setDataOutputStreamByteOrder :: (MonadIO m, IsDataOutputStream o) => o -> Gio.Enums.DataStreamByteOrder -> m ()
setDataOutputStreamByteOrder :: o -> DataStreamByteOrder -> m ()
setDataOutputStreamByteOrder obj :: o
obj val :: 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 "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`.
constructDataOutputStreamByteOrder :: (IsDataOutputStream o) => Gio.Enums.DataStreamByteOrder -> IO (GValueConstruct o)
constructDataOutputStreamByteOrder :: DataStreamByteOrder -> IO (GValueConstruct o)
constructDataOutputStreamByteOrder val :: DataStreamByteOrder
val = String -> DataStreamByteOrder -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "byte-order" DataStreamByteOrder
val

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamByteOrderPropertyInfo
instance AttrInfo DataOutputStreamByteOrderPropertyInfo where
    type AttrAllowedOps DataOutputStreamByteOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DataOutputStreamByteOrderPropertyInfo = IsDataOutputStream
    type AttrSetTypeConstraint DataOutputStreamByteOrderPropertyInfo = (~) Gio.Enums.DataStreamByteOrder
    type AttrTransferTypeConstraint DataOutputStreamByteOrderPropertyInfo = (~) Gio.Enums.DataStreamByteOrder
    type AttrTransferType DataOutputStreamByteOrderPropertyInfo = Gio.Enums.DataStreamByteOrder
    type AttrGetType DataOutputStreamByteOrderPropertyInfo = Gio.Enums.DataStreamByteOrder
    type AttrLabel DataOutputStreamByteOrderPropertyInfo = "byte-order"
    type AttrOrigin DataOutputStreamByteOrderPropertyInfo = DataOutputStream
    attrGet = getDataOutputStreamByteOrder
    attrSet = setDataOutputStreamByteOrder
    attrTransfer _ v = do
        return v
    attrConstruct = constructDataOutputStreamByteOrder
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DataOutputStream
type instance O.AttributeList DataOutputStream = DataOutputStreamAttributeList
type DataOutputStreamAttributeList = ('[ '("baseStream", Gio.FilterOutputStream.FilterOutputStreamBaseStreamPropertyInfo), '("byteOrder", DataOutputStreamByteOrderPropertyInfo), '("closeBaseStream", Gio.FilterOutputStream.FilterOutputStreamCloseBaseStreamPropertyInfo)] :: [(Symbol, *)])
#endif

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

#endif

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

#endif

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

foreign import ccall "g_data_output_stream_new" g_data_output_stream_new :: 
    Ptr Gio.OutputStream.OutputStream ->    -- base_stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    IO (Ptr DataOutputStream)

-- | Creates a new data output stream for /@baseStream@/.
dataOutputStreamNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.OutputStream.IsOutputStream a) =>
    a
    -- ^ /@baseStream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'.
    -> m DataOutputStream
    -- ^ __Returns:__ t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
dataOutputStreamNew :: a -> m DataOutputStream
dataOutputStreamNew baseStream :: a
baseStream = IO DataOutputStream -> m DataOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DataOutputStream -> m DataOutputStream)
-> IO DataOutputStream -> m DataOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
baseStream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseStream
    Ptr DataOutputStream
result <- Ptr OutputStream -> IO (Ptr DataOutputStream)
g_data_output_stream_new Ptr OutputStream
baseStream'
    Text -> Ptr DataOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "dataOutputStreamNew" Ptr DataOutputStream
result
    DataOutputStream
result' <- ((ManagedPtr DataOutputStream -> DataOutputStream)
-> Ptr DataOutputStream -> IO DataOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DataOutputStream -> DataOutputStream
DataOutputStream) Ptr DataOutputStream
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseStream
    DataOutputStream -> IO DataOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return DataOutputStream
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DataOutputStream::get_byte_order
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , 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_output_stream_get_byte_order" g_data_output_stream_get_byte_order :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    IO CUInt

-- | Gets the byte order for the stream.
dataOutputStreamGetByteOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> m Gio.Enums.DataStreamByteOrder
    -- ^ __Returns:__ the t'GI.Gio.Enums.DataStreamByteOrder' for the /@stream@/.
dataOutputStreamGetByteOrder :: a -> m DataStreamByteOrder
dataOutputStreamGetByteOrder stream :: 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 DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CUInt
result <- Ptr DataOutputStream -> IO CUInt
g_data_output_stream_get_byte_order Ptr DataOutputStream
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 DataOutputStreamGetByteOrderMethodInfo
instance (signature ~ (m Gio.Enums.DataStreamByteOrder), MonadIO m, IsDataOutputStream a) => O.MethodInfo DataOutputStreamGetByteOrderMethodInfo a signature where
    overloadedMethod = dataOutputStreamGetByteOrder

#endif

-- method DataOutputStream::put_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #guchar." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_byte" g_data_output_stream_put_byte :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Word8 ->                                -- data : TBasicType TUInt8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts a byte into the output stream.
dataOutputStreamPutByte ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Word8
    -- ^ /@data@/: a @/guchar/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutByte :: a -> Word8 -> Maybe b -> m ()
dataOutputStreamPutByte stream :: a
stream data_ :: Word8
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Word8 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_byte Ptr DataOutputStream
stream' Word8
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutByteMethodInfo
instance (signature ~ (Word8 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutByteMethodInfo a signature where
    overloadedMethod = dataOutputStreamPutByte

#endif

-- method DataOutputStream::put_int16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint16." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_int16" g_data_output_stream_put_int16 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Int16 ->                                -- data : TBasicType TInt16
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts a signed 16-bit integer into the output stream.
dataOutputStreamPutInt16 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Int16
    -- ^ /@data@/: a @/gint16/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutInt16 :: a -> Int16 -> Maybe b -> m ()
dataOutputStreamPutInt16 stream :: a
stream data_ :: Int16
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Int16 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_int16 Ptr DataOutputStream
stream' Int16
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutInt16MethodInfo
instance (signature ~ (Int16 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutInt16MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutInt16

#endif

-- method DataOutputStream::put_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint32." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_int32" g_data_output_stream_put_int32 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Int32 ->                                -- data : TBasicType TInt32
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts a signed 32-bit integer into the output stream.
dataOutputStreamPutInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Int32
    -- ^ /@data@/: a @/gint32/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutInt32 :: a -> Int32 -> Maybe b -> m ()
dataOutputStreamPutInt32 stream :: a
stream data_ :: Int32
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Int32 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_int32 Ptr DataOutputStream
stream' Int32
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutInt32MethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutInt32MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutInt32

#endif

-- method DataOutputStream::put_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint64." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_int64" g_data_output_stream_put_int64 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Int64 ->                                -- data : TBasicType TInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts a signed 64-bit integer into the stream.
dataOutputStreamPutInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Int64
    -- ^ /@data@/: a @/gint64/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutInt64 :: a -> Int64 -> Maybe b -> m ()
dataOutputStreamPutInt64 stream :: a
stream data_ :: Int64
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Int64 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_int64 Ptr DataOutputStream
stream' Int64
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutInt64MethodInfo
instance (signature ~ (Int64 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutInt64MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutInt64

#endif

-- method DataOutputStream::put_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_string" g_data_output_stream_put_string :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    CString ->                              -- str : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts a string into the output stream.
dataOutputStreamPutString ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> T.Text
    -- ^ /@str@/: a string.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutString :: a -> Text -> Maybe b -> m ()
dataOutputStreamPutString stream :: a
stream str :: Text
str cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_string Ptr DataOutputStream
stream' CString
str' 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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutStringMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutStringMethodInfo a signature where
    overloadedMethod = dataOutputStreamPutString

#endif

-- method DataOutputStream::put_uint16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #guint16." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_uint16" g_data_output_stream_put_uint16 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Word16 ->                               -- data : TBasicType TUInt16
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts an unsigned 16-bit integer into the output stream.
dataOutputStreamPutUint16 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Word16
    -- ^ /@data@/: a @/guint16/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutUint16 :: a -> Word16 -> Maybe b -> m ()
dataOutputStreamPutUint16 stream :: a
stream data_ :: Word16
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Word16 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_uint16 Ptr DataOutputStream
stream' Word16
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutUint16MethodInfo
instance (signature ~ (Word16 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutUint16MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutUint16

#endif

-- method DataOutputStream::put_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #guint32." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_uint32" g_data_output_stream_put_uint32 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Word32 ->                               -- data : TBasicType TUInt32
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts an unsigned 32-bit integer into the stream.
dataOutputStreamPutUint32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Word32
    -- ^ /@data@/: a @/guint32/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutUint32 :: a -> Word32 -> Maybe b -> m ()
dataOutputStreamPutUint32 stream :: a
stream data_ :: Word32
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Word32 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_uint32 Ptr DataOutputStream
stream' Word32
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutUint32MethodInfo
instance (signature ~ (Word32 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutUint32MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutUint32

#endif

-- method DataOutputStream::put_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #guint64." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_data_output_stream_put_uint64" g_data_output_stream_put_uint64 :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    Word64 ->                               -- data : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Puts an unsigned 64-bit integer into the stream.
dataOutputStreamPutUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Word64
    -- ^ /@data@/: a @/guint64/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dataOutputStreamPutUint64 :: a -> Word64 -> Maybe b -> m ()
dataOutputStreamPutUint64 stream :: a
stream data_ :: Word64
data_ cancellable :: Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DataOutputStream
-> Word64 -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_data_output_stream_put_uint64 Ptr DataOutputStream
stream' Word64
data_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DataOutputStreamPutUint64MethodInfo
instance (signature ~ (Word64 -> Maybe (b) -> m ()), MonadIO m, IsDataOutputStream a, Gio.Cancellable.IsCancellable b) => O.MethodInfo DataOutputStreamPutUint64MethodInfo a signature where
    overloadedMethod = dataOutputStreamPutUint64

#endif

-- method DataOutputStream::set_byte_order
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DataOutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDataOutputStream."
--                 , 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."
--                 , 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_output_stream_set_byte_order" g_data_output_stream_set_byte_order :: 
    Ptr DataOutputStream ->                 -- stream : TInterface (Name {namespace = "Gio", name = "DataOutputStream"})
    CUInt ->                                -- order : TInterface (Name {namespace = "Gio", name = "DataStreamByteOrder"})
    IO ()

-- | Sets the byte order of the data output stream to /@order@/.
dataOutputStreamSetByteOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsDataOutputStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.DataOutputStream.DataOutputStream'.
    -> Gio.Enums.DataStreamByteOrder
    -- ^ /@order@/: a @/GDataStreamByteOrder/@.
    -> m ()
dataOutputStreamSetByteOrder :: a -> DataStreamByteOrder -> m ()
dataOutputStreamSetByteOrder stream :: a
stream order :: 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 DataOutputStream
stream' <- a -> IO (Ptr DataOutputStream)
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 DataOutputStream -> CUInt -> IO ()
g_data_output_stream_set_byte_order Ptr DataOutputStream
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 DataOutputStreamSetByteOrderMethodInfo
instance (signature ~ (Gio.Enums.DataStreamByteOrder -> m ()), MonadIO m, IsDataOutputStream a) => O.MethodInfo DataOutputStreamSetByteOrderMethodInfo a signature where
    overloadedMethod = dataOutputStreamSetByteOrder

#endif