{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A data structure representing an IO Channel. The fields should be
-- considered private and should only be accessed with the following
-- functions.

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

module GI.GLib.Structs.IOChannel
    ( 

-- * Exported types
    IOChannel(..)                           ,
    newZeroIOChannel                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [close]("GI.GLib.Structs.IOChannel#g:method:close"), [flush]("GI.GLib.Structs.IOChannel#g:method:flush"), [init]("GI.GLib.Structs.IOChannel#g:method:init"), [read]("GI.GLib.Structs.IOChannel#g:method:read"), [readChars]("GI.GLib.Structs.IOChannel#g:method:readChars"), [readLine]("GI.GLib.Structs.IOChannel#g:method:readLine"), [readToEnd]("GI.GLib.Structs.IOChannel#g:method:readToEnd"), [readUnichar]("GI.GLib.Structs.IOChannel#g:method:readUnichar"), [ref]("GI.GLib.Structs.IOChannel#g:method:ref"), [seek]("GI.GLib.Structs.IOChannel#g:method:seek"), [seekPosition]("GI.GLib.Structs.IOChannel#g:method:seekPosition"), [shutdown]("GI.GLib.Structs.IOChannel#g:method:shutdown"), [unixGetFd]("GI.GLib.Structs.IOChannel#g:method:unixGetFd"), [unref]("GI.GLib.Structs.IOChannel#g:method:unref"), [write]("GI.GLib.Structs.IOChannel#g:method:write"), [writeChars]("GI.GLib.Structs.IOChannel#g:method:writeChars"), [writeUnichar]("GI.GLib.Structs.IOChannel#g:method:writeUnichar").
-- 
-- ==== Getters
-- [getBufferCondition]("GI.GLib.Structs.IOChannel#g:method:getBufferCondition"), [getBufferSize]("GI.GLib.Structs.IOChannel#g:method:getBufferSize"), [getBuffered]("GI.GLib.Structs.IOChannel#g:method:getBuffered"), [getCloseOnUnref]("GI.GLib.Structs.IOChannel#g:method:getCloseOnUnref"), [getEncoding]("GI.GLib.Structs.IOChannel#g:method:getEncoding"), [getFlags]("GI.GLib.Structs.IOChannel#g:method:getFlags"), [getLineTerm]("GI.GLib.Structs.IOChannel#g:method:getLineTerm").
-- 
-- ==== Setters
-- [setBufferSize]("GI.GLib.Structs.IOChannel#g:method:setBufferSize"), [setBuffered]("GI.GLib.Structs.IOChannel#g:method:setBuffered"), [setCloseOnUnref]("GI.GLib.Structs.IOChannel#g:method:setCloseOnUnref"), [setEncoding]("GI.GLib.Structs.IOChannel#g:method:setEncoding"), [setFlags]("GI.GLib.Structs.IOChannel#g:method:setFlags"), [setLineTerm]("GI.GLib.Structs.IOChannel#g:method:setLineTerm").

#if defined(ENABLE_OVERLOADING)
    ResolveIOChannelMethod                  ,
#endif

-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    IOChannelCloseMethodInfo                ,
#endif
    iOChannelClose                          ,


-- ** errorFromErrno #method:errorFromErrno#

    iOChannelErrorFromErrno                 ,


-- ** errorQuark #method:errorQuark#

    iOChannelErrorQuark                     ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    IOChannelFlushMethodInfo                ,
#endif
    iOChannelFlush                          ,


-- ** getBufferCondition #method:getBufferCondition#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetBufferConditionMethodInfo   ,
#endif
    iOChannelGetBufferCondition             ,


-- ** getBufferSize #method:getBufferSize#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetBufferSizeMethodInfo        ,
#endif
    iOChannelGetBufferSize                  ,


-- ** getBuffered #method:getBuffered#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetBufferedMethodInfo          ,
#endif
    iOChannelGetBuffered                    ,


-- ** getCloseOnUnref #method:getCloseOnUnref#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetCloseOnUnrefMethodInfo      ,
#endif
    iOChannelGetCloseOnUnref                ,


-- ** getEncoding #method:getEncoding#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetEncodingMethodInfo          ,
#endif
    iOChannelGetEncoding                    ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetFlagsMethodInfo             ,
#endif
    iOChannelGetFlags                       ,


-- ** getLineTerm #method:getLineTerm#

#if defined(ENABLE_OVERLOADING)
    IOChannelGetLineTermMethodInfo          ,
#endif
    iOChannelGetLineTerm                    ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    IOChannelInitMethodInfo                 ,
#endif
    iOChannelInit                           ,


-- ** newFile #method:newFile#

    iOChannelNewFile                        ,


-- ** read #method:read#

#if defined(ENABLE_OVERLOADING)
    IOChannelReadMethodInfo                 ,
#endif
    iOChannelRead                           ,


-- ** readChars #method:readChars#

#if defined(ENABLE_OVERLOADING)
    IOChannelReadCharsMethodInfo            ,
#endif
    iOChannelReadChars                      ,


-- ** readLine #method:readLine#

#if defined(ENABLE_OVERLOADING)
    IOChannelReadLineMethodInfo             ,
#endif
    iOChannelReadLine                       ,


-- ** readToEnd #method:readToEnd#

#if defined(ENABLE_OVERLOADING)
    IOChannelReadToEndMethodInfo            ,
#endif
    iOChannelReadToEnd                      ,


-- ** readUnichar #method:readUnichar#

#if defined(ENABLE_OVERLOADING)
    IOChannelReadUnicharMethodInfo          ,
#endif
    iOChannelReadUnichar                    ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IOChannelRefMethodInfo                  ,
#endif
    iOChannelRef                            ,


-- ** seek #method:seek#

#if defined(ENABLE_OVERLOADING)
    IOChannelSeekMethodInfo                 ,
#endif
    iOChannelSeek                           ,


-- ** seekPosition #method:seekPosition#

#if defined(ENABLE_OVERLOADING)
    IOChannelSeekPositionMethodInfo         ,
#endif
    iOChannelSeekPosition                   ,


-- ** setBufferSize #method:setBufferSize#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetBufferSizeMethodInfo        ,
#endif
    iOChannelSetBufferSize                  ,


-- ** setBuffered #method:setBuffered#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetBufferedMethodInfo          ,
#endif
    iOChannelSetBuffered                    ,


-- ** setCloseOnUnref #method:setCloseOnUnref#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetCloseOnUnrefMethodInfo      ,
#endif
    iOChannelSetCloseOnUnref                ,


-- ** setEncoding #method:setEncoding#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetEncodingMethodInfo          ,
#endif
    iOChannelSetEncoding                    ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetFlagsMethodInfo             ,
#endif
    iOChannelSetFlags                       ,


-- ** setLineTerm #method:setLineTerm#

#if defined(ENABLE_OVERLOADING)
    IOChannelSetLineTermMethodInfo          ,
#endif
    iOChannelSetLineTerm                    ,


-- ** shutdown #method:shutdown#

#if defined(ENABLE_OVERLOADING)
    IOChannelShutdownMethodInfo             ,
#endif
    iOChannelShutdown                       ,


-- ** unixGetFd #method:unixGetFd#

#if defined(ENABLE_OVERLOADING)
    IOChannelUnixGetFdMethodInfo            ,
#endif
    iOChannelUnixGetFd                      ,


-- ** unixNew #method:unixNew#

    iOChannelUnixNew                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IOChannelUnrefMethodInfo                ,
#endif
    iOChannelUnref                          ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    IOChannelWriteMethodInfo                ,
#endif
    iOChannelWrite                          ,


-- ** writeChars #method:writeChars#

#if defined(ENABLE_OVERLOADING)
    IOChannelWriteCharsMethodInfo           ,
#endif
    iOChannelWriteChars                     ,


-- ** writeUnichar #method:writeUnichar#

#if defined(ENABLE_OVERLOADING)
    IOChannelWriteUnicharMethodInfo         ,
#endif
    iOChannelWriteUnichar                   ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.GLib.Enums as GLib.Enums
import {-# SOURCE #-} qualified GI.GLib.Flags as GLib.Flags

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

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

foreign import ccall "g_io_channel_get_type" c_g_io_channel_get_type :: 
    IO GType

type instance O.ParentTypes IOChannel = '[]
instance O.HasParentTypes IOChannel

instance B.Types.TypedObject IOChannel where
    glibType :: IO GType
glibType = IO GType
c_g_io_channel_get_type

instance B.Types.GBoxed IOChannel

-- | Convert 'IOChannel' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe IOChannel) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_io_channel_get_type
    gvalueSet_ :: Ptr GValue -> Maybe IOChannel -> IO ()
gvalueSet_ Ptr GValue
gv Maybe IOChannel
P.Nothing = Ptr GValue -> Ptr IOChannel -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr IOChannel
forall a. Ptr a
FP.nullPtr :: FP.Ptr IOChannel)
    gvalueSet_ Ptr GValue
gv (P.Just IOChannel
obj) = IOChannel -> (Ptr IOChannel -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IOChannel
obj (Ptr GValue -> Ptr IOChannel -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe IOChannel)
gvalueGet_ Ptr GValue
gv = do
        Ptr IOChannel
ptr <- Ptr GValue -> IO (Ptr IOChannel)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr IOChannel)
        if Ptr IOChannel
ptr Ptr IOChannel -> Ptr IOChannel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr IOChannel
forall a. Ptr a
FP.nullPtr
        then IOChannel -> Maybe IOChannel
forall a. a -> Maybe a
P.Just (IOChannel -> Maybe IOChannel)
-> IO IOChannel -> IO (Maybe IOChannel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IOChannel -> IOChannel
IOChannel Ptr IOChannel
ptr
        else Maybe IOChannel -> IO (Maybe IOChannel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IOChannel
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `IOChannel` struct initialized to zero.
newZeroIOChannel :: MonadIO m => m IOChannel
newZeroIOChannel :: forall (m :: * -> *). MonadIO m => m IOChannel
newZeroIOChannel = IO IOChannel -> m IOChannel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOChannel -> m IOChannel) -> IO IOChannel -> m IOChannel
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr IOChannel)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
136 IO (Ptr IOChannel)
-> (Ptr IOChannel -> IO IOChannel) -> IO IOChannel
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel

instance tag ~ 'AttrSet => Constructible IOChannel tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr IOChannel -> IOChannel)
-> [AttrOp IOChannel tag] -> m IOChannel
new ManagedPtr IOChannel -> IOChannel
_ [AttrOp IOChannel tag]
attrs = do
        IOChannel
o <- m IOChannel
forall (m :: * -> *). MonadIO m => m IOChannel
newZeroIOChannel
        IOChannel -> [AttrOp IOChannel 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set IOChannel
o [AttrOp IOChannel tag]
[AttrOp IOChannel 'AttrSet]
attrs
        IOChannel -> m IOChannel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IOChannel
o



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IOChannel
type instance O.AttributeList IOChannel = IOChannelAttributeList
type IOChannelAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method IOChannel::new_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A string containing the name of a file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "One of \"r\", \"w\", \"a\", \"r+\", \"w+\", \"a+\". These have\n       the same meaning as in fopen()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOChannel" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_new_file" g_io_channel_new_file :: 
    CString ->                              -- filename : TBasicType TFileName
    CString ->                              -- mode : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IOChannel)

-- | Open a file /@filename@/ as a t'GI.GLib.Structs.IOChannel.IOChannel' using mode /@mode@/. This
-- channel will be closed when the last reference to it is dropped,
-- so there is no need to call 'GI.GLib.Structs.IOChannel.iOChannelClose' (though doing
-- so will not cause problems, as long as no attempt is made to
-- access the channel after it is closed).
iOChannelNewFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filename@/: A string containing the name of a file
    -> T.Text
    -- ^ /@mode@/: One of \"r\", \"w\", \"a\", \"r+\", \"w+\", \"a+\". These have
    --        the same meaning as in @/fopen()/@
    -> m IOChannel
    -- ^ __Returns:__ A t'GI.GLib.Structs.IOChannel.IOChannel' on success, 'P.Nothing' on failure. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelNewFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Char] -> Text -> m IOChannel
iOChannelNewFile [Char]
filename Text
mode = IO IOChannel -> m IOChannel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOChannel -> m IOChannel) -> IO IOChannel -> m IOChannel
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- [Char] -> IO CString
stringToCString [Char]
filename
    CString
mode' <- Text -> IO CString
textToCString Text
mode
    IO IOChannel -> IO () -> IO IOChannel
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr IOChannel
result <- (Ptr (Ptr GError) -> IO (Ptr IOChannel)) -> IO (Ptr IOChannel)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IOChannel)) -> IO (Ptr IOChannel))
-> (Ptr (Ptr GError) -> IO (Ptr IOChannel)) -> IO (Ptr IOChannel)
forall a b. (a -> b) -> a -> b
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr IOChannel)
g_io_channel_new_file CString
filename' CString
mode'
        Text -> Ptr IOChannel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iOChannelNewFile" Ptr IOChannel
result
        IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel) Ptr IOChannel
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mode'
        IOChannel -> IO IOChannel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOChannel
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mode'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method IOChannel::unix_new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOChannel" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_unix_new" g_io_channel_unix_new :: 
    Int32 ->                                -- fd : TBasicType TInt
    IO (Ptr IOChannel)

-- | Creates a new t'GI.GLib.Structs.IOChannel.IOChannel' given a file descriptor. On UNIX systems
-- this works for plain files, pipes, and sockets.
-- 
-- The returned t'GI.GLib.Structs.IOChannel.IOChannel' has a reference count of 1.
-- 
-- The default encoding for t'GI.GLib.Structs.IOChannel.IOChannel' is UTF-8. If your application
-- is reading output from a command using via pipe, you may need to set
-- the encoding to the encoding of the current locale (see
-- 'GI.GLib.Functions.getCharset') with the 'GI.GLib.Structs.IOChannel.iOChannelSetEncoding' function.
-- By default, the fd passed will not be closed when the final reference
-- to the t'GI.GLib.Structs.IOChannel.IOChannel' data structure is dropped.
-- 
-- If you want to read raw binary data without interpretation, then
-- call the 'GI.GLib.Structs.IOChannel.iOChannelSetEncoding' function with 'P.Nothing' for the
-- encoding argument.
-- 
-- This function is available in GLib on Windows, too, but you should
-- avoid using it on Windows. The domain of file descriptors and
-- sockets overlap. There is no way for GLib to know which one you mean
-- in case the argument you pass to this function happens to be both a
-- valid file descriptor and socket. If that happens a warning is
-- issued, and GLib assumes that it is the file descriptor you mean.
iOChannelUnixNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@fd@/: a file descriptor.
    -> m IOChannel
    -- ^ __Returns:__ a new t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelUnixNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m IOChannel
iOChannelUnixNew Int32
fd = IO IOChannel -> m IOChannel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOChannel -> m IOChannel) -> IO IOChannel -> m IOChannel
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
result <- Int32 -> IO (Ptr IOChannel)
g_io_channel_unix_new Int32
fd
    Text -> Ptr IOChannel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iOChannelUnixNew" Ptr IOChannel
result
    IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel) Ptr IOChannel
result
    IOChannel -> IO IOChannel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOChannel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IOChannel::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_close" g_io_channel_close :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO ()

{-# DEPRECATED iOChannelClose ["(Since version 2.2)","Use 'GI.GLib.Structs.IOChannel.iOChannelShutdown' instead."] #-}
-- | Close an IO channel. Any pending data to be written will be
-- flushed, ignoring errors. The channel will not be freed until the
-- last reference is dropped using 'GI.GLib.Structs.IOChannel.iOChannelUnref'.
iOChannelClose ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: A t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ()
iOChannelClose :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m ()
iOChannelClose IOChannel
channel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr IOChannel -> IO ()
g_io_channel_close Ptr IOChannel
channel'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelCloseMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IOChannelCloseMethodInfo IOChannel signature where
    overloadedMethod = iOChannelClose

instance O.OverloadedMethodInfo IOChannelCloseMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelClose"
        })


#endif

-- method IOChannel::flush
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_flush" g_io_channel_flush :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Flushes the write buffer for the GIOChannel.
iOChannelFlush ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ the status of the operation: One of
    --   'GI.GLib.Enums.IOStatusNormal', 'GI.GLib.Enums.IOStatusAgain', or
    --   'GI.GLib.Enums.IOStatusError'. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelFlush :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m IOStatus
iOChannelFlush IOChannel
channel = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_flush Ptr IOChannel
channel'
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelFlushMethodInfo
instance (signature ~ (m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelFlushMethodInfo IOChannel signature where
    overloadedMethod = iOChannelFlush

instance O.OverloadedMethodInfo IOChannelFlushMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelFlush",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelFlush"
        })


#endif

-- method IOChannel::get_buffer_condition
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "IOCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_get_buffer_condition" g_io_channel_get_buffer_condition :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO CUInt

-- | This function returns a t'GI.GLib.Flags.IOCondition' depending on whether there
-- is data to be read\/space to write data in the internal buffers in
-- the t'GI.GLib.Structs.IOChannel.IOChannel'. Only the flags 'GI.GLib.Flags.IOConditionIn' and 'GI.GLib.Flags.IOConditionOut' may be set.
iOChannelGetBufferCondition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: A t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m [GLib.Flags.IOCondition]
    -- ^ __Returns:__ A t'GI.GLib.Flags.IOCondition'
iOChannelGetBufferCondition :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m [IOCondition]
iOChannelGetBufferCondition IOChannel
channel = IO [IOCondition] -> m [IOCondition]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [IOCondition] -> m [IOCondition])
-> IO [IOCondition] -> m [IOCondition]
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CUInt
result <- Ptr IOChannel -> IO CUInt
g_io_channel_get_buffer_condition Ptr IOChannel
channel'
    let result' :: [IOCondition]
result' = CUInt -> [IOCondition]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    [IOCondition] -> IO [IOCondition]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IOCondition]
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetBufferConditionMethodInfo
instance (signature ~ (m [GLib.Flags.IOCondition]), MonadIO m) => O.OverloadedMethod IOChannelGetBufferConditionMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetBufferCondition

instance O.OverloadedMethodInfo IOChannelGetBufferConditionMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetBufferCondition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetBufferCondition"
        })


#endif

-- method IOChannel::get_buffer_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_get_buffer_size" g_io_channel_get_buffer_size :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO Word64

-- | Gets the buffer size.
iOChannelGetBufferSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m Word64
    -- ^ __Returns:__ the size of the buffer.
iOChannelGetBufferSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m Word64
iOChannelGetBufferSize IOChannel
channel = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Word64
result <- Ptr IOChannel -> IO Word64
g_io_channel_get_buffer_size Ptr IOChannel
channel'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data IOChannelGetBufferSizeMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod IOChannelGetBufferSizeMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetBufferSize

instance O.OverloadedMethodInfo IOChannelGetBufferSizeMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetBufferSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetBufferSize"
        })


#endif

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

foreign import ccall "g_io_channel_get_buffered" g_io_channel_get_buffered :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO CInt

-- | Returns whether /@channel@/ is buffered.
iOChannelGetBuffered ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@channel@/ is buffered.
iOChannelGetBuffered :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m Bool
iOChannelGetBuffered IOChannel
channel = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CInt
result <- Ptr IOChannel -> IO CInt
g_io_channel_get_buffered Ptr IOChannel
channel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetBufferedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IOChannelGetBufferedMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetBuffered

instance O.OverloadedMethodInfo IOChannelGetBufferedMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetBuffered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetBuffered"
        })


#endif

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

foreign import ccall "g_io_channel_get_close_on_unref" g_io_channel_get_close_on_unref :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO CInt

-- | Returns whether the file\/socket\/whatever associated with /@channel@/
-- will be closed when /@channel@/ receives its final unref and is
-- destroyed. The default value of this is 'P.True' for channels created
-- by g_io_channel_new_file (), and 'P.False' for all other channels.
iOChannelGetCloseOnUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the channel will be closed, 'P.False' otherwise.
iOChannelGetCloseOnUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m Bool
iOChannelGetCloseOnUnref IOChannel
channel = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CInt
result <- Ptr IOChannel -> IO CInt
g_io_channel_get_close_on_unref Ptr IOChannel
channel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetCloseOnUnrefMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IOChannelGetCloseOnUnrefMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetCloseOnUnref

instance O.OverloadedMethodInfo IOChannelGetCloseOnUnrefMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetCloseOnUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetCloseOnUnref"
        })


#endif

-- method IOChannel::get_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_get_encoding" g_io_channel_get_encoding :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO CString

-- | Gets the encoding for the input\/output of the channel.
-- The internal encoding is always UTF-8. The encoding 'P.Nothing'
-- makes the channel safe for binary data.
iOChannelGetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m T.Text
    -- ^ __Returns:__ A string containing the encoding, this string is
    --   owned by GLib and must not be freed.
iOChannelGetEncoding :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m Text
iOChannelGetEncoding IOChannel
channel = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CString
result <- Ptr IOChannel -> IO CString
g_io_channel_get_encoding Ptr IOChannel
channel'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iOChannelGetEncoding" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetEncodingMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IOChannelGetEncodingMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetEncoding

instance O.OverloadedMethodInfo IOChannelGetEncodingMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetEncoding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetEncoding"
        })


#endif

-- method IOChannel::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_get_flags" g_io_channel_get_flags :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO CUInt

-- | Gets the current flags for a t'GI.GLib.Structs.IOChannel.IOChannel', including read-only
-- flags such as 'GI.GLib.Flags.IOFlagsIsReadable'.
-- 
-- The values of the flags 'GI.GLib.Flags.IOFlagsIsReadable' and 'GI.GLib.Flags.IOFlagsIsWritable'
-- are cached for internal use by the channel when it is created.
-- If they should change at some later point (e.g. partial shutdown
-- of a socket with the UNIX @/shutdown()/@ function), the user
-- should immediately call 'GI.GLib.Structs.IOChannel.iOChannelGetFlags' to update
-- the internal values of these flags.
iOChannelGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m [GLib.Flags.IOFlags]
    -- ^ __Returns:__ the flags which are set on the channel
iOChannelGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m [IOFlags]
iOChannelGetFlags IOChannel
channel = IO [IOFlags] -> m [IOFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [IOFlags] -> m [IOFlags]) -> IO [IOFlags] -> m [IOFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CUInt
result <- Ptr IOChannel -> IO CUInt
g_io_channel_get_flags Ptr IOChannel
channel'
    let result' :: [IOFlags]
result' = CUInt -> [IOFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    [IOFlags] -> IO [IOFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IOFlags]
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetFlagsMethodInfo
instance (signature ~ (m [GLib.Flags.IOFlags]), MonadIO m) => O.OverloadedMethod IOChannelGetFlagsMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetFlags

instance O.OverloadedMethodInfo IOChannelGetFlagsMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetFlags"
        })


#endif

-- method IOChannel::get_line_term
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a location to return the length of the line terminator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_get_line_term" g_io_channel_get_line_term :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr Int32 ->                            -- length : TBasicType TInt
    IO CString

-- | This returns the string that t'GI.GLib.Structs.IOChannel.IOChannel' uses to determine
-- where in the file a line break occurs. A value of 'P.Nothing'
-- indicates autodetection.
iOChannelGetLineTerm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ((T.Text, Int32))
    -- ^ __Returns:__ The line termination string. This value
    --   is owned by GLib and must not be freed.
iOChannelGetLineTerm :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m (Text, Int32)
iOChannelGetLineTerm IOChannel
channel = IO (Text, Int32) -> m (Text, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Int32) -> m (Text, Int32))
-> IO (Text, Int32) -> m (Text, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr Int32
length_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CString
result <- Ptr IOChannel -> Ptr Int32 -> IO CString
g_io_channel_get_line_term Ptr IOChannel
channel' Ptr Int32
length_
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iOChannelGetLineTerm" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Int32
length_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
length_
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
length_
    (Text, Int32) -> IO (Text, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
result', Int32
length_')

#if defined(ENABLE_OVERLOADING)
data IOChannelGetLineTermMethodInfo
instance (signature ~ (m ((T.Text, Int32))), MonadIO m) => O.OverloadedMethod IOChannelGetLineTermMethodInfo IOChannel signature where
    overloadedMethod = iOChannelGetLineTerm

instance O.OverloadedMethodInfo IOChannelGetLineTermMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelGetLineTerm",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelGetLineTerm"
        })


#endif

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

foreign import ccall "g_io_channel_init" g_io_channel_init :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO ()

-- | Initializes a t'GI.GLib.Structs.IOChannel.IOChannel' struct.
-- 
-- This is called by each of the above functions when creating a
-- t'GI.GLib.Structs.IOChannel.IOChannel', and so is not often needed by the application
-- programmer (unless you are creating a new type of t'GI.GLib.Structs.IOChannel.IOChannel').
iOChannelInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ()
iOChannelInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m ()
iOChannelInit IOChannel
channel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr IOChannel -> IO ()
g_io_channel_init Ptr IOChannel
channel'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IOChannelInitMethodInfo IOChannel signature where
    overloadedMethod = iOChannelInit

instance O.OverloadedMethodInfo IOChannelInitMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelInit"
        })


#endif

-- method IOChannel::read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a buffer to read the data into (which should be at least\n      count bytes long)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of bytes to read from the #GIOChannel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_read"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "returns the number of bytes actually read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOError" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_read" g_io_channel_read :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CString ->                              -- buf : TBasicType TUTF8
    Word64 ->                               -- count : TBasicType TUInt64
    Word64 ->                               -- bytes_read : TBasicType TUInt64
    IO CUInt

{-# DEPRECATED iOChannelRead ["(Since version 2.2)","Use 'GI.GLib.Structs.IOChannel.iOChannelReadChars' instead."] #-}
-- | Reads data from a t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelRead ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> T.Text
    -- ^ /@buf@/: a buffer to read the data into (which should be at least
    --       count bytes long)
    -> Word64
    -- ^ /@count@/: the number of bytes to read from the t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Word64
    -- ^ /@bytesRead@/: returns the number of bytes actually read
    -> m GLib.Enums.IOError
    -- ^ __Returns:__ 'GI.GLib.Enums.IOErrorNone' if the operation was successful.
iOChannelRead :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Text -> Word64 -> Word64 -> m IOError
iOChannelRead IOChannel
channel Text
buf Word64
count Word64
bytesRead = IO IOError -> m IOError
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOError -> m IOError) -> IO IOError -> m IOError
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CString
buf' <- Text -> IO CString
textToCString Text
buf
    CUInt
result <- Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt
g_io_channel_read Ptr IOChannel
channel' CString
buf' Word64
count Word64
bytesRead
    let result' :: IOError
result' = (Int -> IOError
forall a. Enum a => Int -> a
toEnum (Int -> IOError) -> (CUInt -> Int) -> CUInt -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
buf'
    IOError -> IO IOError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOError
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelReadMethodInfo
instance (signature ~ (T.Text -> Word64 -> Word64 -> m GLib.Enums.IOError), MonadIO m) => O.OverloadedMethod IOChannelReadMethodInfo IOChannel signature where
    overloadedMethod = iOChannelRead

instance O.OverloadedMethodInfo IOChannelReadMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelRead",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelRead"
        })


#endif

-- method IOChannel::read_chars
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "\n    a buffer to read data into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the size of the buffer. Note that the buffer may not be\n    completely filled even if there is data in the buffer if the\n    remaining data is not a complete character."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_read"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The number of bytes read. This may be\n    zero even on success if count < 6 and the channel's encoding\n    is non-%NULL. This indicates that the next UTF-8 character is\n    too wide for the buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "the size of the buffer. Note that the buffer may not be\n    completely filled even if there is data in the buffer if the\n    remaining data is not a complete character."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_read_chars" g_io_channel_read_chars :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr Word8 ->                            -- buf : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    Ptr Word64 ->                           -- bytes_read : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Replacement for 'GI.GLib.Structs.IOChannel.iOChannelRead' with the new API.
iOChannelReadChars ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> ByteString
    -- ^ /@buf@/: 
    --     a buffer to read data into
    -> m ((GLib.Enums.IOStatus, ByteString, Word64))
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelReadChars :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> ByteString -> m (IOStatus, ByteString, Word64)
iOChannelReadChars IOChannel
channel ByteString
buf = IO (IOStatus, ByteString, Word64)
-> m (IOStatus, ByteString, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IOStatus, ByteString, Word64)
 -> m (IOStatus, ByteString, Word64))
-> IO (IOStatus, ByteString, Word64)
-> m (IOStatus, ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buf
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr Word8
buf' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buf
    Ptr Word64
bytesRead <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (IOStatus, ByteString, Word64)
-> IO () -> IO (IOStatus, ByteString, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel
-> Ptr Word8
-> Word64
-> Ptr Word64
-> Ptr (Ptr GError)
-> IO CUInt
g_io_channel_read_chars Ptr IOChannel
channel' Ptr Word8
buf' Word64
count Ptr Word64
bytesRead
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        ByteString
buf'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
count) Ptr Word8
buf'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
        Word64
bytesRead' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesRead
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesRead
        (IOStatus, ByteString, Word64) -> IO (IOStatus, ByteString, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOStatus
result', ByteString
buf'', Word64
bytesRead')
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesRead
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelReadCharsMethodInfo
instance (signature ~ (ByteString -> m ((GLib.Enums.IOStatus, ByteString, Word64))), MonadIO m) => O.OverloadedMethod IOChannelReadCharsMethodInfo IOChannel signature where
    overloadedMethod = iOChannelReadChars

instance O.OverloadedMethodInfo IOChannelReadCharsMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelReadChars",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelReadChars"
        })


#endif

-- method IOChannel::read_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str_return"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The line read from the #GIOChannel, including the\n             line terminator. This data should be freed with g_free()\n             when no longer needed. This is a nul-terminated string.\n             If a @length of zero is returned, this will be %NULL instead."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store length of the read data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "terminator_pos"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store position of line terminator, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_read_line" g_io_channel_read_line :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr CString ->                          -- str_return : TBasicType TUTF8
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr Word64 ->                           -- terminator_pos : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Reads a line, including the terminating character(s),
-- from a t'GI.GLib.Structs.IOChannel.IOChannel' into a newly-allocated string.
-- /@strReturn@/ will contain allocated memory if the return
-- is 'GI.GLib.Enums.IOStatusNormal'.
iOChannelReadLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ((GLib.Enums.IOStatus, T.Text, Word64, Word64))
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelReadLine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m (IOStatus, Text, Word64, Word64)
iOChannelReadLine IOChannel
channel = IO (IOStatus, Text, Word64, Word64)
-> m (IOStatus, Text, Word64, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IOStatus, Text, Word64, Word64)
 -> m (IOStatus, Text, Word64, Word64))
-> IO (IOStatus, Text, Word64, Word64)
-> m (IOStatus, Text, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr CString
strReturn <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
terminatorPos <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (IOStatus, Text, Word64, Word64)
-> IO () -> IO (IOStatus, Text, Word64, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel
-> Ptr CString
-> Ptr Word64
-> Ptr Word64
-> Ptr (Ptr GError)
-> IO CUInt
g_io_channel_read_line Ptr IOChannel
channel' Ptr CString
strReturn Ptr Word64
length_ Ptr Word64
terminatorPos
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        CString
strReturn' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
strReturn
        Text
strReturn'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
strReturn'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
strReturn'
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        Word64
terminatorPos' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
terminatorPos
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
strReturn
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
terminatorPos
        (IOStatus, Text, Word64, Word64)
-> IO (IOStatus, Text, Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOStatus
result', Text
strReturn'', Word64
length_', Word64
terminatorPos')
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
strReturn
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
terminatorPos
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelReadLineMethodInfo
instance (signature ~ (m ((GLib.Enums.IOStatus, T.Text, Word64, Word64))), MonadIO m) => O.OverloadedMethod IOChannelReadLineMethodInfo IOChannel signature where
    overloadedMethod = iOChannelReadLine

instance O.OverloadedMethodInfo IOChannelReadLineMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelReadLine",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelReadLine"
        })


#endif

-- method IOChannel::read_to_end
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str_return"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Location to\n             store a pointer to a string holding the remaining data in the\n             #GIOChannel. This data should be freed with g_free() when no\n             longer needed. This data is terminated by an extra nul\n             character, but there may be other nuls in the intervening data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store length of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "location to store length of the data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_read_to_end" g_io_channel_read_to_end :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr (Ptr Word8) ->                      -- str_return : TCArray False (-1) 2 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Reads all the remaining data from the file.
iOChannelReadToEnd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ((GLib.Enums.IOStatus, ByteString))
    -- ^ __Returns:__ 'GI.GLib.Enums.IOStatusNormal' on success.
    --     This function never returns 'GI.GLib.Enums.IOStatusEof'. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelReadToEnd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m (IOStatus, ByteString)
iOChannelReadToEnd IOChannel
channel = IO (IOStatus, ByteString) -> m (IOStatus, ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IOStatus, ByteString) -> m (IOStatus, ByteString))
-> IO (IOStatus, ByteString) -> m (IOStatus, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr (Ptr Word8)
strReturn <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (IOStatus, ByteString) -> IO () -> IO (IOStatus, ByteString)
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel
-> Ptr (Ptr Word8) -> Ptr Word64 -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_read_to_end Ptr IOChannel
channel' Ptr (Ptr Word8)
strReturn Ptr Word64
length_
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        Ptr Word8
strReturn' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
strReturn
        ByteString
strReturn'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
strReturn'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
strReturn'
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
strReturn
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        (IOStatus, ByteString) -> IO (IOStatus, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOStatus
result', ByteString
strReturn'')
     ) (do
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
strReturn
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelReadToEndMethodInfo
instance (signature ~ (m ((GLib.Enums.IOStatus, ByteString))), MonadIO m) => O.OverloadedMethod IOChannelReadToEndMethodInfo IOChannel signature where
    overloadedMethod = iOChannelReadToEnd

instance O.OverloadedMethodInfo IOChannelReadToEndMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelReadToEnd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelReadToEnd"
        })


#endif

-- method IOChannel::read_unichar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "thechar"
--           , argType = TBasicType TUniChar
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to return a character"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_read_unichar" g_io_channel_read_unichar :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr CInt ->                             -- thechar : TBasicType TUniChar
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Reads a Unicode character from /@channel@/.
-- This function cannot be called on a channel with 'P.Nothing' encoding.
iOChannelReadUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ((GLib.Enums.IOStatus, Char))
    -- ^ __Returns:__ a t'GI.GLib.Enums.IOStatus' /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelReadUnichar :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m (IOStatus, Char)
iOChannelReadUnichar IOChannel
channel = IO (IOStatus, Char) -> m (IOStatus, Char)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IOStatus, Char) -> m (IOStatus, Char))
-> IO (IOStatus, Char) -> m (IOStatus, Char)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr CInt
thechar <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (IOStatus, Char) -> IO () -> IO (IOStatus, Char)
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> Ptr CInt -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_read_unichar Ptr IOChannel
channel' Ptr CInt
thechar
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        CInt
thechar' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
thechar
        let thechar'' :: Char
thechar'' = (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
thechar'
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
thechar
        (IOStatus, Char) -> IO (IOStatus, Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOStatus
result', Char
thechar'')
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
thechar
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelReadUnicharMethodInfo
instance (signature ~ (m ((GLib.Enums.IOStatus, Char))), MonadIO m) => O.OverloadedMethod IOChannelReadUnicharMethodInfo IOChannel signature where
    overloadedMethod = iOChannelReadUnichar

instance O.OverloadedMethodInfo IOChannelReadUnicharMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelReadUnichar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelReadUnichar"
        })


#endif

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

foreign import ccall "g_io_channel_ref" g_io_channel_ref :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO (Ptr IOChannel)

-- | Increments the reference count of a t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m IOChannel
    -- ^ __Returns:__ the /@channel@/ that was passed in (since 2.6)
iOChannelRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m IOChannel
iOChannelRef IOChannel
channel = IO IOChannel -> m IOChannel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOChannel -> m IOChannel) -> IO IOChannel -> m IOChannel
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr IOChannel
result <- Ptr IOChannel -> IO (Ptr IOChannel)
g_io_channel_ref Ptr IOChannel
channel'
    Text -> Ptr IOChannel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iOChannelRef" Ptr IOChannel
result
    IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel) Ptr IOChannel
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    IOChannel -> IO IOChannel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOChannel
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelRefMethodInfo
instance (signature ~ (m IOChannel), MonadIO m) => O.OverloadedMethod IOChannelRefMethodInfo IOChannel signature where
    overloadedMethod = iOChannelRef

instance O.OverloadedMethodInfo IOChannelRefMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelRef"
        })


#endif

-- method IOChannel::seek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an offset, in bytes, which is added to the position specified\n         by @type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the position in the file, which can be %G_SEEK_CUR (the current\n       position), %G_SEEK_SET (the start of the file), or %G_SEEK_END\n       (the end of the file)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOError" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_seek" g_io_channel_seek :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Int64 ->                                -- offset : TBasicType TInt64
    CUInt ->                                -- type : TInterface (Name {namespace = "GLib", name = "SeekType"})
    IO CUInt

{-# DEPRECATED iOChannelSeek ["(Since version 2.2)","Use 'GI.GLib.Structs.IOChannel.iOChannelSeekPosition' instead."] #-}
-- | Sets the current position in the t'GI.GLib.Structs.IOChannel.IOChannel', similar to the standard
-- library function @/fseek()/@.
iOChannelSeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Int64
    -- ^ /@offset@/: an offset, in bytes, which is added to the position specified
    --          by /@type@/
    -> GLib.Enums.SeekType
    -- ^ /@type@/: the position in the file, which can be 'GI.GLib.Enums.SeekTypeCur' (the current
    --        position), 'GI.GLib.Enums.SeekTypeSet' (the start of the file), or 'GI.GLib.Enums.SeekTypeEnd'
    --        (the end of the file)
    -> m GLib.Enums.IOError
    -- ^ __Returns:__ 'GI.GLib.Enums.IOErrorNone' if the operation was successful.
iOChannelSeek :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Int64 -> SeekType -> m IOError
iOChannelSeek IOChannel
channel Int64
offset SeekType
type_ = IO IOError -> m IOError
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOError -> m IOError) -> IO IOError -> m IOError
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
type_
    CUInt
result <- Ptr IOChannel -> Int64 -> CUInt -> IO CUInt
g_io_channel_seek Ptr IOChannel
channel' Int64
offset CUInt
type_'
    let result' :: IOError
result' = (Int -> IOError
forall a. Enum a => Int -> a
toEnum (Int -> IOError) -> (CUInt -> Int) -> CUInt -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    IOError -> IO IOError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOError
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelSeekMethodInfo
instance (signature ~ (Int64 -> GLib.Enums.SeekType -> m GLib.Enums.IOError), MonadIO m) => O.OverloadedMethod IOChannelSeekMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSeek

instance O.OverloadedMethodInfo IOChannelSeekMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSeek",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSeek"
        })


#endif

-- method IOChannel::seek_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The offset in bytes from the position specified by @type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GSeekType. The type %G_SEEK_CUR is only allowed in those\n                     cases where a call to g_io_channel_set_encoding ()\n                     is allowed. See the documentation for\n                     g_io_channel_set_encoding () for details."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_seek_position" g_io_channel_seek_position :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Int64 ->                                -- offset : TBasicType TInt64
    CUInt ->                                -- type : TInterface (Name {namespace = "GLib", name = "SeekType"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Replacement for 'GI.GLib.Structs.IOChannel.iOChannelSeek' with the new API.
iOChannelSeekPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Int64
    -- ^ /@offset@/: The offset in bytes from the position specified by /@type@/
    -> GLib.Enums.SeekType
    -- ^ /@type@/: a t'GI.GLib.Enums.SeekType'. The type 'GI.GLib.Enums.SeekTypeCur' is only allowed in those
    --                      cases where a call to g_io_channel_set_encoding ()
    --                      is allowed. See the documentation for
    --                      g_io_channel_set_encoding () for details.
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelSeekPosition :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Int64 -> SeekType -> m IOStatus
iOChannelSeekPosition IOChannel
channel Int64
offset SeekType
type_ = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
type_
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> Int64 -> CUInt -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_seek_position Ptr IOChannel
channel' Int64
offset CUInt
type_'
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelSeekPositionMethodInfo
instance (signature ~ (Int64 -> GLib.Enums.SeekType -> m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelSeekPositionMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSeekPosition

instance O.OverloadedMethodInfo IOChannelSeekPositionMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSeekPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSeekPosition"
        })


#endif

-- method IOChannel::set_buffer_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the size of the buffer, or 0 to let GLib pick a good size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_set_buffer_size" g_io_channel_set_buffer_size :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Word64 ->                               -- size : TBasicType TUInt64
    IO ()

-- | Sets the buffer size.
iOChannelSetBufferSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Word64
    -- ^ /@size@/: the size of the buffer, or 0 to let GLib pick a good size
    -> m ()
iOChannelSetBufferSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Word64 -> m ()
iOChannelSetBufferSize IOChannel
channel Word64
size = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr IOChannel -> Word64 -> IO ()
g_io_channel_set_buffer_size Ptr IOChannel
channel' Word64
size
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetBufferSizeMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.OverloadedMethod IOChannelSetBufferSizeMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetBufferSize

instance O.OverloadedMethodInfo IOChannelSetBufferSizeMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetBufferSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetBufferSize"
        })


#endif

-- method IOChannel::set_buffered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffered"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to set the channel buffered or unbuffered"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_set_buffered" g_io_channel_set_buffered :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CInt ->                                 -- buffered : TBasicType TBoolean
    IO ()

-- | The buffering state can only be set if the channel\'s encoding
-- is 'P.Nothing'. For any other encoding, the channel must be buffered.
-- 
-- A buffered channel can only be set unbuffered if the channel\'s
-- internal buffers have been flushed. Newly created channels or
-- channels which have returned 'GI.GLib.Enums.IOStatusEof'
-- not require such a flush. For write-only channels, a call to
-- g_io_channel_flush () is sufficient. For all other channels,
-- the buffers may be flushed by a call to g_io_channel_seek_position ().
-- This includes the possibility of seeking with seek type 'GI.GLib.Enums.SeekTypeCur'
-- and an offset of zero. Note that this means that socket-based
-- channels cannot be set unbuffered once they have had data
-- read from them.
-- 
-- On unbuffered channels, it is safe to mix read and write
-- calls from the new and old APIs, if this is necessary for
-- maintaining old code.
-- 
-- The default state of the channel is buffered.
iOChannelSetBuffered ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Bool
    -- ^ /@buffered@/: whether to set the channel buffered or unbuffered
    -> m ()
iOChannelSetBuffered :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Bool -> m ()
iOChannelSetBuffered IOChannel
channel Bool
buffered = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let buffered' :: CInt
buffered' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
buffered
    Ptr IOChannel -> CInt -> IO ()
g_io_channel_set_buffered Ptr IOChannel
channel' CInt
buffered'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetBufferedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod IOChannelSetBufferedMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetBuffered

instance O.OverloadedMethodInfo IOChannelSetBufferedMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetBuffered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetBuffered"
        })


#endif

-- method IOChannel::set_close_on_unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "do_close"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether to close the channel on the final unref of\n           the GIOChannel data structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_set_close_on_unref" g_io_channel_set_close_on_unref :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CInt ->                                 -- do_close : TBasicType TBoolean
    IO ()

-- | Whether to close the channel on the final unref of the t'GI.GLib.Structs.IOChannel.IOChannel'
-- data structure. The default value of this is 'P.True' for channels
-- created by g_io_channel_new_file (), and 'P.False' for all other channels.
-- 
-- Setting this flag to 'P.True' for a channel you have already closed
-- can cause problems when the final reference to the t'GI.GLib.Structs.IOChannel.IOChannel' is dropped.
iOChannelSetCloseOnUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Bool
    -- ^ /@doClose@/: Whether to close the channel on the final unref of
    --            the GIOChannel data structure.
    -> m ()
iOChannelSetCloseOnUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Bool -> m ()
iOChannelSetCloseOnUnref IOChannel
channel Bool
doClose = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let doClose' :: CInt
doClose' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
doClose
    Ptr IOChannel -> CInt -> IO ()
g_io_channel_set_close_on_unref Ptr IOChannel
channel' CInt
doClose'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetCloseOnUnrefMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod IOChannelSetCloseOnUnrefMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetCloseOnUnref

instance O.OverloadedMethodInfo IOChannelSetCloseOnUnrefMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetCloseOnUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetCloseOnUnref"
        })


#endif

-- method IOChannel::set_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoding type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_set_encoding" g_io_channel_set_encoding :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CString ->                              -- encoding : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Sets the encoding for the input\/output of the channel.
-- The internal encoding is always UTF-8. The default encoding
-- for the external file is UTF-8.
-- 
-- The encoding 'P.Nothing' is safe to use with binary data.
-- 
-- The encoding can only be set if one of the following conditions
-- is true:
-- 
-- * The channel was just created, and has not been written to or read from yet.
-- * The channel is write-only.
-- * The channel is a file, and the file pointer was just repositioned
-- by a call to 'GI.GLib.Structs.IOChannel.iOChannelSeekPosition'. (This flushes all the
-- internal buffers.)
-- * The current encoding is 'P.Nothing' or UTF-8.
-- * One of the (new API) read functions has just returned 'GI.GLib.Enums.IOStatusEof'
-- (or, in the case of 'GI.GLib.Structs.IOChannel.iOChannelReadToEnd', 'GI.GLib.Enums.IOStatusNormal').
-- *  One of the functions 'GI.GLib.Structs.IOChannel.iOChannelReadChars' or
--  'GI.GLib.Structs.IOChannel.iOChannelReadUnichar' has returned 'GI.GLib.Enums.IOStatusAgain' or
--  'GI.GLib.Enums.IOStatusError'. This may be useful in the case of
--  'GI.GLib.Enums.ConvertErrorIllegalSequence'.
--  Returning one of these statuses from 'GI.GLib.Structs.IOChannel.iOChannelReadLine',
--  @/g_io_channel_read_line_string()/@, or 'GI.GLib.Structs.IOChannel.iOChannelReadToEnd'
--  does not guarantee that the encoding can be changed.
-- 
-- 
-- Channels which do not meet one of the above conditions cannot call
-- 'GI.GLib.Structs.IOChannel.iOChannelSeekPosition' with an offset of 'GI.GLib.Enums.SeekTypeCur', and, if
-- they are \"seekable\", cannot call 'GI.GLib.Structs.IOChannel.iOChannelWriteChars' after
-- calling one of the API \"read\" functions.
iOChannelSetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Maybe (T.Text)
    -- ^ /@encoding@/: the encoding type
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ 'GI.GLib.Enums.IOStatusNormal' if the encoding was successfully set /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelSetEncoding :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Maybe Text -> m IOStatus
iOChannelSetEncoding IOChannel
channel Maybe Text
encoding = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CString
maybeEncoding <- case Maybe Text
encoding of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEncoding -> do
            CString
jEncoding' <- Text -> IO CString
textToCString Text
jEncoding
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEncoding'
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> CString -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_set_encoding Ptr IOChannel
channel' CString
maybeEncoding
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEncoding
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEncoding
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelSetEncodingMethodInfo
instance (signature ~ (Maybe (T.Text) -> m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelSetEncodingMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetEncoding

instance O.OverloadedMethodInfo IOChannelSetEncodingMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetEncoding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetEncoding"
        })


#endif

-- method IOChannel::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags to set on the IO channel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_set_flags" g_io_channel_set_flags :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GLib", name = "IOFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Sets the (writeable) flags in /@channel@/ to (/@flags@/ & 'GI.GLib.Flags.IOFlagsSetMask').
iOChannelSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> [GLib.Flags.IOFlags]
    -- ^ /@flags@/: the flags to set on the IO channel
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelSetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> [IOFlags] -> m IOStatus
iOChannelSetFlags IOChannel
channel [IOFlags]
flags = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let flags' :: CUInt
flags' = [IOFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IOFlags]
flags
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> CUInt -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_set_flags Ptr IOChannel
channel' CUInt
flags'
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelSetFlagsMethodInfo
instance (signature ~ ([GLib.Flags.IOFlags] -> m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelSetFlagsMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetFlags

instance O.OverloadedMethodInfo IOChannelSetFlagsMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetFlags"
        })


#endif

-- method IOChannel::set_line_term
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_term"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The line termination string. Use %NULL for\n            autodetect.  Autodetection breaks on \"\\n\", \"\\r\\n\", \"\\r\", \"\\0\",\n            and the Unicode paragraph separator. Autodetection should not be\n            used for anything other than file-based channels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The length of the termination string. If -1 is passed, the\n         string is assumed to be nul-terminated. This option allows\n         termination strings with embedded nuls."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_set_line_term" g_io_channel_set_line_term :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CString ->                              -- line_term : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    IO ()

-- | This sets the string that t'GI.GLib.Structs.IOChannel.IOChannel' uses to determine
-- where in the file a line break occurs.
iOChannelSetLineTerm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Maybe (T.Text)
    -- ^ /@lineTerm@/: The line termination string. Use 'P.Nothing' for
    --             autodetect.  Autodetection breaks on \"\\n\", \"\\r\\n\", \"\\r\", \"\\0\",
    --             and the Unicode paragraph separator. Autodetection should not be
    --             used for anything other than file-based channels.
    -> Int32
    -- ^ /@length@/: The length of the termination string. If -1 is passed, the
    --          string is assumed to be nul-terminated. This option allows
    --          termination strings with embedded nuls.
    -> m ()
iOChannelSetLineTerm :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Maybe Text -> Int32 -> m ()
iOChannelSetLineTerm IOChannel
channel Maybe Text
lineTerm Int32
length_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CString
maybeLineTerm <- case Maybe Text
lineTerm of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLineTerm -> do
            CString
jLineTerm' <- Text -> IO CString
textToCString Text
jLineTerm
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLineTerm'
    Ptr IOChannel -> CString -> Int32 -> IO ()
g_io_channel_set_line_term Ptr IOChannel
channel' CString
maybeLineTerm Int32
length_
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLineTerm
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetLineTermMethodInfo
instance (signature ~ (Maybe (T.Text) -> Int32 -> m ()), MonadIO m) => O.OverloadedMethod IOChannelSetLineTermMethodInfo IOChannel signature where
    overloadedMethod = iOChannelSetLineTerm

instance O.OverloadedMethodInfo IOChannelSetLineTermMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelSetLineTerm",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelSetLineTerm"
        })


#endif

-- method IOChannel::shutdown
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flush"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if %TRUE, flush pending"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_shutdown" g_io_channel_shutdown :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CInt ->                                 -- flush : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Close an IO channel. Any pending data to be written will be
-- flushed if /@flush@/ is 'P.True'. The channel will not be freed until the
-- last reference is dropped using 'GI.GLib.Structs.IOChannel.iOChannelUnref'.
iOChannelShutdown ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Bool
    -- ^ /@flush@/: if 'P.True', flush pending
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelShutdown :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Bool -> m IOStatus
iOChannelShutdown IOChannel
channel Bool
flush = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let flush' :: CInt
flush' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
flush
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> CInt -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_shutdown Ptr IOChannel
channel' CInt
flush'
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelShutdownMethodInfo
instance (signature ~ (Bool -> m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelShutdownMethodInfo IOChannel signature where
    overloadedMethod = iOChannelShutdown

instance O.OverloadedMethodInfo IOChannelShutdownMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelShutdown",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelShutdown"
        })


#endif

-- method IOChannel::unix_get_fd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GIOChannel, created with g_io_channel_unix_new()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_unix_get_fd" g_io_channel_unix_get_fd :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO Int32

-- | Returns the file descriptor of the t'GI.GLib.Structs.IOChannel.IOChannel'.
-- 
-- On Windows this function returns the file descriptor or socket of
-- the t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelUnixGetFd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel', created with 'GI.GLib.Structs.IOChannel.iOChannelUnixNew'.
    -> m Int32
    -- ^ __Returns:__ the file descriptor of the t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelUnixGetFd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m Int32
iOChannelUnixGetFd IOChannel
channel = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Int32
result <- Ptr IOChannel -> IO Int32
g_io_channel_unix_get_fd Ptr IOChannel
channel'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IOChannelUnixGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod IOChannelUnixGetFdMethodInfo IOChannel signature where
    overloadedMethod = iOChannelUnixGetFd

instance O.OverloadedMethodInfo IOChannelUnixGetFdMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelUnixGetFd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelUnixGetFd"
        })


#endif

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

foreign import ccall "g_io_channel_unref" g_io_channel_unref :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    IO ()

-- | Decrements the reference count of a t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> m ()
iOChannelUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> m ()
iOChannelUnref IOChannel
channel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr IOChannel -> IO ()
g_io_channel_unref Ptr IOChannel
channel'
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IOChannelUnrefMethodInfo IOChannel signature where
    overloadedMethod = iOChannelUnref

instance O.OverloadedMethodInfo IOChannelUnrefMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelUnref"
        })


#endif

-- method IOChannel::write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer containing the data to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes actually written"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOError" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_write" g_io_channel_write :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CString ->                              -- buf : TBasicType TUTF8
    Word64 ->                               -- count : TBasicType TUInt64
    Word64 ->                               -- bytes_written : TBasicType TUInt64
    IO CUInt

{-# DEPRECATED iOChannelWrite ["(Since version 2.2)","Use 'GI.GLib.Structs.IOChannel.iOChannelWriteChars' instead."] #-}
-- | Writes data to a t'GI.GLib.Structs.IOChannel.IOChannel'.
iOChannelWrite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> T.Text
    -- ^ /@buf@/: the buffer containing the data to write
    -> Word64
    -- ^ /@count@/: the number of bytes to write
    -> Word64
    -- ^ /@bytesWritten@/: the number of bytes actually written
    -> m GLib.Enums.IOError
    -- ^ __Returns:__ 'GI.GLib.Enums.IOErrorNone' if the operation was successful.
iOChannelWrite :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Text -> Word64 -> Word64 -> m IOError
iOChannelWrite IOChannel
channel Text
buf Word64
count Word64
bytesWritten = IO IOError -> m IOError
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOError -> m IOError) -> IO IOError -> m IOError
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    CString
buf' <- Text -> IO CString
textToCString Text
buf
    CUInt
result <- Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt
g_io_channel_write Ptr IOChannel
channel' CString
buf' Word64
count Word64
bytesWritten
    let result' :: IOError
result' = (Int -> IOError
forall a. Enum a => Int -> a
toEnum (Int -> IOError) -> (CUInt -> Int) -> CUInt -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
buf'
    IOError -> IO IOError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOError
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelWriteMethodInfo
instance (signature ~ (T.Text -> Word64 -> Word64 -> m GLib.Enums.IOError), MonadIO m) => O.OverloadedMethod IOChannelWriteMethodInfo IOChannel signature where
    overloadedMethod = iOChannelWrite

instance O.OverloadedMethodInfo IOChannelWriteMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelWrite",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelWrite"
        })


#endif

-- method IOChannel::write_chars
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffer to write data from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the size of the buffer. If -1, the buffer\n        is taken to be a nul-terminated string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes_written"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The number of bytes written. This can be nonzero\n                even if the return value is not %G_IO_STATUS_NORMAL.\n                If the return value is %G_IO_STATUS_NORMAL and the\n                channel is blocking, this will always be equal\n                to @count if @count >= 0."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_write_chars" g_io_channel_write_chars :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    Ptr Word8 ->                            -- buf : TCArray False (-1) (-1) (TBasicType TUInt8)
    Int64 ->                                -- count : TBasicType TInt64
    Ptr Word64 ->                           -- bytes_written : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Replacement for 'GI.GLib.Structs.IOChannel.iOChannelWrite' with the new API.
-- 
-- On seekable channels with encodings other than 'P.Nothing' or UTF-8, generic
-- mixing of reading and writing is not allowed. A call to g_io_channel_write_chars ()
-- may only be made on a channel from which data has been read in the
-- cases described in the documentation for g_io_channel_set_encoding ().
iOChannelWriteChars ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Ptr Word8
    -- ^ /@buf@/: a buffer to write data from
    -> Int64
    -- ^ /@count@/: the size of the buffer. If -1, the buffer
    --         is taken to be a nul-terminated string.
    -> m ((GLib.Enums.IOStatus, Word64))
    -- ^ __Returns:__ the status of the operation. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelWriteChars :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Ptr Word8 -> Int64 -> m (IOStatus, Word64)
iOChannelWriteChars IOChannel
channel Ptr Word8
buf Int64
count = IO (IOStatus, Word64) -> m (IOStatus, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IOStatus, Word64) -> m (IOStatus, Word64))
-> IO (IOStatus, Word64) -> m (IOStatus, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    Ptr Word64
bytesWritten <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (IOStatus, Word64) -> IO () -> IO (IOStatus, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel
-> Ptr Word8 -> Int64 -> Ptr Word64 -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_write_chars Ptr IOChannel
channel' Ptr Word8
buf Int64
count Ptr Word64
bytesWritten
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        Word64
bytesWritten' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
bytesWritten
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
        (IOStatus, Word64) -> IO (IOStatus, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOStatus
result', Word64
bytesWritten')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
bytesWritten
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelWriteCharsMethodInfo
instance (signature ~ (Ptr Word8 -> Int64 -> m ((GLib.Enums.IOStatus, Word64))), MonadIO m) => O.OverloadedMethod IOChannelWriteCharsMethodInfo IOChannel signature where
    overloadedMethod = iOChannelWriteChars

instance O.OverloadedMethodInfo IOChannelWriteCharsMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelWriteChars",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelWriteChars"
        })


#endif

-- method IOChannel::write_unichar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "channel"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "IOChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOChannel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "thechar"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a character" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "IOStatus" })
-- throws : True
-- Skip return : False

foreign import ccall "g_io_channel_write_unichar" g_io_channel_write_unichar :: 
    Ptr IOChannel ->                        -- channel : TInterface (Name {namespace = "GLib", name = "IOChannel"})
    CInt ->                                 -- thechar : TBasicType TUniChar
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Writes a Unicode character to /@channel@/.
-- This function cannot be called on a channel with 'P.Nothing' encoding.
iOChannelWriteUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IOChannel
    -- ^ /@channel@/: a t'GI.GLib.Structs.IOChannel.IOChannel'
    -> Char
    -- ^ /@thechar@/: a character
    -> m GLib.Enums.IOStatus
    -- ^ __Returns:__ a t'GI.GLib.Enums.IOStatus' /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelWriteUnichar :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IOChannel -> Char -> m IOStatus
iOChannelWriteUnichar IOChannel
channel Char
thechar = IO IOStatus -> m IOStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStatus -> m IOStatus) -> IO IOStatus -> m IOStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOChannel
channel' <- IOChannel -> IO (Ptr IOChannel)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IOChannel
channel
    let thechar' :: CInt
thechar' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
SP.ord) Char
thechar
    IO IOStatus -> IO () -> IO IOStatus
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr IOChannel -> CInt -> Ptr (Ptr GError) -> IO CUInt
g_io_channel_write_unichar Ptr IOChannel
channel' CInt
thechar'
        let result' :: IOStatus
result' = (Int -> IOStatus
forall a. Enum a => Int -> a
toEnum (Int -> IOStatus) -> (CUInt -> Int) -> CUInt -> IOStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
        IOStatus -> IO IOStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelWriteUnicharMethodInfo
instance (signature ~ (Char -> m GLib.Enums.IOStatus), MonadIO m) => O.OverloadedMethod IOChannelWriteUnicharMethodInfo IOChannel signature where
    overloadedMethod = iOChannelWriteUnichar

instance O.OverloadedMethodInfo IOChannelWriteUnicharMethodInfo IOChannel where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.IOChannel.iOChannelWriteUnichar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-IOChannel.html#v:iOChannelWriteUnichar"
        })


#endif

-- method IOChannel::error_from_errno
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "en"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an `errno` error number, e.g. `EINVAL`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "IOChannelError" })
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_error_from_errno" g_io_channel_error_from_errno :: 
    Int32 ->                                -- en : TBasicType TInt
    IO CUInt

-- | Converts an @errno@ error number to a t'GI.GLib.Enums.IOChannelError'.
iOChannelErrorFromErrno ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@en@/: an @errno@ error number, e.g. @EINVAL@
    -> m GLib.Enums.IOChannelError
    -- ^ __Returns:__ a t'GI.GLib.Enums.IOChannelError' error number, e.g.
    --      'GI.GLib.Enums.IOChannelErrorInval'.
iOChannelErrorFromErrno :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m IOChannelError
iOChannelErrorFromErrno Int32
en = IO IOChannelError -> m IOChannelError
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOChannelError -> m IOChannelError)
-> IO IOChannelError -> m IOChannelError
forall a b. (a -> b) -> a -> b
$ do
    CUInt
result <- Int32 -> IO CUInt
g_io_channel_error_from_errno Int32
en
    let result' :: IOChannelError
result' = (Int -> IOChannelError
forall a. Enum a => Int -> a
toEnum (Int -> IOChannelError)
-> (CUInt -> Int) -> CUInt -> IOChannelError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IOChannelError -> IO IOChannelError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOChannelError
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IOChannel::error_quark
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_io_channel_error_quark" g_io_channel_error_quark :: 
    IO Word32

-- | /No description available in the introspection data./
iOChannelErrorQuark ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
iOChannelErrorQuark :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
iOChannelErrorQuark  = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
g_io_channel_error_quark
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIOChannelMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIOChannelMethod "close" o = IOChannelCloseMethodInfo
    ResolveIOChannelMethod "flush" o = IOChannelFlushMethodInfo
    ResolveIOChannelMethod "init" o = IOChannelInitMethodInfo
    ResolveIOChannelMethod "read" o = IOChannelReadMethodInfo
    ResolveIOChannelMethod "readChars" o = IOChannelReadCharsMethodInfo
    ResolveIOChannelMethod "readLine" o = IOChannelReadLineMethodInfo
    ResolveIOChannelMethod "readToEnd" o = IOChannelReadToEndMethodInfo
    ResolveIOChannelMethod "readUnichar" o = IOChannelReadUnicharMethodInfo
    ResolveIOChannelMethod "ref" o = IOChannelRefMethodInfo
    ResolveIOChannelMethod "seek" o = IOChannelSeekMethodInfo
    ResolveIOChannelMethod "seekPosition" o = IOChannelSeekPositionMethodInfo
    ResolveIOChannelMethod "shutdown" o = IOChannelShutdownMethodInfo
    ResolveIOChannelMethod "unixGetFd" o = IOChannelUnixGetFdMethodInfo
    ResolveIOChannelMethod "unref" o = IOChannelUnrefMethodInfo
    ResolveIOChannelMethod "write" o = IOChannelWriteMethodInfo
    ResolveIOChannelMethod "writeChars" o = IOChannelWriteCharsMethodInfo
    ResolveIOChannelMethod "writeUnichar" o = IOChannelWriteUnicharMethodInfo
    ResolveIOChannelMethod "getBufferCondition" o = IOChannelGetBufferConditionMethodInfo
    ResolveIOChannelMethod "getBufferSize" o = IOChannelGetBufferSizeMethodInfo
    ResolveIOChannelMethod "getBuffered" o = IOChannelGetBufferedMethodInfo
    ResolveIOChannelMethod "getCloseOnUnref" o = IOChannelGetCloseOnUnrefMethodInfo
    ResolveIOChannelMethod "getEncoding" o = IOChannelGetEncodingMethodInfo
    ResolveIOChannelMethod "getFlags" o = IOChannelGetFlagsMethodInfo
    ResolveIOChannelMethod "getLineTerm" o = IOChannelGetLineTermMethodInfo
    ResolveIOChannelMethod "setBufferSize" o = IOChannelSetBufferSizeMethodInfo
    ResolveIOChannelMethod "setBuffered" o = IOChannelSetBufferedMethodInfo
    ResolveIOChannelMethod "setCloseOnUnref" o = IOChannelSetCloseOnUnrefMethodInfo
    ResolveIOChannelMethod "setEncoding" o = IOChannelSetEncodingMethodInfo
    ResolveIOChannelMethod "setFlags" o = IOChannelSetFlagsMethodInfo
    ResolveIOChannelMethod "setLineTerm" o = IOChannelSetLineTermMethodInfo
    ResolveIOChannelMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveIOChannelMethod t IOChannel, O.OverloadedMethod info IOChannel p, R.HasField t IOChannel p) => R.HasField t IOChannel p where
    getField = O.overloadedMethod @info

#endif

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

#endif