{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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                        ,
    noIOChannel                             ,


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

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

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

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

instance BoxedObject IOChannel where
    boxedType :: IOChannel -> IO GType
boxedType _ = IO GType
c_g_io_channel_get_type

-- | Convert 'IOChannel' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue IOChannel where
    toGValue :: IOChannel -> IO GValue
toGValue o :: IOChannel
o = do
        GType
gtype <- IO GType
c_g_io_channel_get_type
        IOChannel -> (Ptr IOChannel -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IOChannel
o (GType
-> (GValue -> Ptr IOChannel -> IO ()) -> Ptr IOChannel -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr IOChannel -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO IOChannel
fromGValue gv :: GValue
gv = do
        Ptr IOChannel
ptr <- GValue -> IO (Ptr IOChannel)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr IOChannel)
        (ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IOChannel -> IOChannel
IOChannel Ptr IOChannel
ptr
        
    

-- | Construct a `IOChannel` struct initialized to zero.
newZeroIOChannel :: MonadIO m => m IOChannel
newZeroIOChannel :: m IOChannel
newZeroIOChannel = IO IOChannel -> m IOChannel
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. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 136 IO (Ptr IOChannel)
-> (Ptr IOChannel -> IO IOChannel) -> IO IOChannel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel

instance tag ~ 'AttrSet => Constructible IOChannel tag where
    new :: (ManagedPtr IOChannel -> IOChannel)
-> [AttrOp IOChannel tag] -> m IOChannel
new _ attrs :: [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 (m :: * -> *) a. Monad m => a -> m a
return IOChannel
o


-- | A convenience alias for `Nothing` :: `Maybe` `IOChannel`.
noIOChannel :: Maybe IOChannel
noIOChannel :: Maybe IOChannel
noIOChannel = Maybe IOChannel
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IOChannel
type instance O.AttributeList IOChannel = IOChannelAttributeList
type IOChannelAttributeList = ('[ ] :: [(Symbol, *)])
#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 :: [Char] -> Text -> m IOChannel
iOChannelNewFile filename :: [Char]
filename mode :: Text
mode = IO IOChannel -> m IOChannel
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 "iOChannelNewFile" Ptr IOChannel
result
        IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, BoxedObject 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 (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 :: Int32 -> m IOChannel
iOChannelUnixNew fd :: Int32
fd = IO IOChannel -> m IOChannel
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 "iOChannelUnixNew" Ptr IOChannel
result
    IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IOChannel -> IOChannel
IOChannel) Ptr IOChannel
result
    IOChannel -> IO IOChannel
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 :: IOChannel -> m ()
iOChannelClose channel :: IOChannel
channel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelCloseMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IOChannelCloseMethodInfo IOChannel signature where
    overloadedMethod = 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
    --   @/G_IO_STATUS_NORMAL/@, @/G_IO_STATUS_AGAIN/@, or
    --   @/G_IO_STATUS_ERROR/@. /(Can throw 'Data.GI.Base.GError.GError')/
iOChannelFlush :: IOChannel -> m IOStatus
iOChannelFlush channel :: IOChannel
channel = IO IOStatus -> m IOStatus
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 (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IOChannelFlushMethodInfo
instance (signature ~ (m GLib.Enums.IOStatus), MonadIO m) => O.MethodInfo IOChannelFlushMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m [IOCondition]
iOChannelGetBufferCondition channel :: IOChannel
channel = IO [IOCondition] -> m [IOCondition]
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 (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.MethodInfo IOChannelGetBufferConditionMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m Word64
iOChannelGetBufferSize channel :: IOChannel
channel = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data IOChannelGetBufferSizeMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.MethodInfo IOChannelGetBufferSizeMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m Bool
iOChannelGetBuffered channel :: IOChannel
channel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
/= 0) CInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetBufferedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IOChannelGetBufferedMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m Bool
iOChannelGetCloseOnUnref channel :: IOChannel
channel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
/= 0) CInt
result
    IOChannel -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IOChannel
channel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetCloseOnUnrefMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IOChannelGetCloseOnUnrefMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m Text
iOChannelGetEncoding channel :: IOChannel
channel = IO Text -> m Text
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 "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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetEncodingMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo IOChannelGetEncodingMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m [IOFlags]
iOChannelGetFlags channel :: IOChannel
channel = IO [IOFlags] -> m [IOFlags]
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 (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.MethodInfo IOChannelGetFlagsMethodInfo IOChannel signature where
    overloadedMethod = 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 = DirectionIn
--           , 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 = TransferNothing
--           }
--       ]
-- 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"})
    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'
    -> Int32
    -- ^ /@length@/: a location to return the length of the line terminator
    -> m T.Text
    -- ^ __Returns:__ The line termination string. This value
    --   is owned by GLib and must not be freed.
iOChannelGetLineTerm :: IOChannel -> Int32 -> m Text
iOChannelGetLineTerm channel :: IOChannel
channel length_ :: Int32
length_ = IO Text -> m Text
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 -> Int32 -> IO CString
g_io_channel_get_line_term Ptr IOChannel
channel' Int32
length_
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iOChannelGetLineTerm" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelGetLineTermMethodInfo
instance (signature ~ (Int32 -> m T.Text), MonadIO m) => O.MethodInfo IOChannelGetLineTermMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m ()
iOChannelInit channel :: IOChannel
channel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IOChannelInitMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Text -> Word64 -> Word64 -> m IOError
iOChannelRead channel :: IOChannel
channel buf :: Text
buf count :: Word64
count bytesRead :: Word64
bytesRead = IO IOError -> m IOError
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 (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.MethodInfo IOChannelReadMethodInfo IOChannel signature where
    overloadedMethod = 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    complelely 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    complelely 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 :: IOChannel -> ByteString -> m (IOStatus, ByteString, Word64)
iOChannelReadChars channel :: IOChannel
channel buf :: ByteString
buf = IO (IOStatus, ByteString, Word64)
-> m (IOStatus, ByteString, Word64)
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 (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.MethodInfo IOChannelReadCharsMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m (IOStatus, Text, Word64, Word64)
iOChannelReadLine channel :: IOChannel
channel = IO (IOStatus, Text, Word64, Word64)
-> m (IOStatus, Text, Word64, Word64)
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)
allocMem :: 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 (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.MethodInfo IOChannelReadLineMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m (IOStatus, ByteString)
iOChannelReadToEnd channel :: IOChannel
channel = IO (IOStatus, ByteString) -> m (IOStatus, ByteString)
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)
allocMem :: 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 (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.MethodInfo IOChannelReadToEndMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m (IOStatus, Char)
iOChannelReadUnichar channel :: IOChannel
channel = IO (IOStatus, Char) -> m (IOStatus, Char)
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 (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.MethodInfo IOChannelReadUnicharMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m IOChannel
iOChannelRef channel :: IOChannel
channel = IO IOChannel -> m IOChannel
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 "iOChannelRef" Ptr IOChannel
result
    IOChannel
result' <- ((ManagedPtr IOChannel -> IOChannel)
-> Ptr IOChannel -> IO IOChannel
forall a.
(HasCallStack, BoxedObject 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 (m :: * -> *) a. Monad m => a -> m a
return IOChannel
result'

#if defined(ENABLE_OVERLOADING)
data IOChannelRefMethodInfo
instance (signature ~ (m IOChannel), MonadIO m) => O.MethodInfo IOChannelRefMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Int64 -> SeekType -> m IOError
iOChannelSeek channel :: IOChannel
channel offset :: Int64
offset type_ :: SeekType
type_ = IO IOError -> m IOError
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 (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.MethodInfo IOChannelSeekMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Int64 -> SeekType -> m IOStatus
iOChannelSeekPosition channel :: IOChannel
channel offset :: Int64
offset type_ :: SeekType
type_ = IO IOStatus -> m IOStatus
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 (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
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.MethodInfo IOChannelSeekPositionMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Word64 -> m ()
iOChannelSetBufferSize channel :: IOChannel
channel size :: Word64
size = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetBufferSizeMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.MethodInfo IOChannelSetBufferSizeMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Bool -> m ()
iOChannelSetBuffered channel :: IOChannel
channel buffered :: Bool
buffered = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
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
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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetBufferedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo IOChannelSetBufferedMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Bool -> m ()
iOChannelSetCloseOnUnref channel :: IOChannel
channel doClose :: Bool
doClose = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
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
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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetCloseOnUnrefMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo IOChannelSetCloseOnUnrefMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Maybe Text -> m IOStatus
iOChannelSetEncoding channel :: IOChannel
channel encoding :: Maybe Text
encoding = IO IOStatus -> m IOStatus
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
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jEncoding :: Text
jEncoding -> do
            CString
jEncoding' <- Text -> IO CString
textToCString Text
jEncoding
            CString -> IO CString
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 (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.MethodInfo IOChannelSetEncodingMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> [IOFlags] -> m IOStatus
iOChannelSetFlags channel :: IOChannel
channel flags :: [IOFlags]
flags = IO IOStatus -> m IOStatus
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 (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
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.MethodInfo IOChannelSetFlagsMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Maybe Text -> Int32 -> m ()
iOChannelSetLineTerm channel :: IOChannel
channel lineTerm :: Maybe Text
lineTerm length_ :: Int32
length_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jLineTerm :: Text
jLineTerm -> do
            CString
jLineTerm' <- Text -> IO CString
textToCString Text
jLineTerm
            CString -> IO CString
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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelSetLineTermMethodInfo
instance (signature ~ (Maybe (T.Text) -> Int32 -> m ()), MonadIO m) => O.MethodInfo IOChannelSetLineTermMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Bool -> m IOStatus
iOChannelShutdown channel :: IOChannel
channel flush :: Bool
flush = IO IOStatus -> m IOStatus
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
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
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 (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
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.MethodInfo IOChannelShutdownMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m Int32
iOChannelUnixGetFd channel :: IOChannel
channel = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IOChannelUnixGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo IOChannelUnixGetFdMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> m ()
iOChannelUnref channel :: IOChannel
channel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IOChannelUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IOChannelUnrefMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Text -> Word64 -> Word64 -> m IOError
iOChannelWrite channel :: IOChannel
channel buf :: Text
buf count :: Word64
count bytesWritten :: Word64
bytesWritten = IO IOError -> m IOError
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 (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.MethodInfo IOChannelWriteMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Ptr Word8 -> Int64 -> m (IOStatus, Word64)
iOChannelWriteChars channel :: IOChannel
channel buf :: Ptr Word8
buf count :: Int64
count = IO (IOStatus, Word64) -> m (IOStatus, Word64)
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 (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.MethodInfo IOChannelWriteCharsMethodInfo IOChannel signature where
    overloadedMethod = 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 :: IOChannel -> Char -> m IOStatus
iOChannelWriteUnichar channel :: IOChannel
channel thechar :: Char
thechar = IO IOStatus -> m IOStatus
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
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
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 (m :: * -> *) a. Monad m => a -> m a
return IOStatus
result'
     ) (do
        () -> IO ()
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.MethodInfo IOChannelWriteUnicharMethodInfo IOChannel signature where
    overloadedMethod = 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 :: Int32 -> m IOChannelError
iOChannelErrorFromErrno en :: Int32
en = IO IOChannelError -> m IOChannelError
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 (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 :: m Word32
iOChannelErrorQuark  = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
g_io_channel_error_quark
    Word32 -> IO Word32
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 :: *) :: * 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.MethodInfo 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

#endif