{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) A data structure representing an IO Channel. The fields should be considered private and should only be accessed with the following functions. -} module GI.GLib.Structs.IOChannel ( -- * Exported types IOChannel(..) , noIOChannel , -- * Methods -- ** iOChannelClose iOChannelClose , -- ** iOChannelFlush iOChannelFlush , -- ** iOChannelGetBufferCondition iOChannelGetBufferCondition , -- ** iOChannelGetBufferSize iOChannelGetBufferSize , -- ** iOChannelGetBuffered iOChannelGetBuffered , -- ** iOChannelGetCloseOnUnref iOChannelGetCloseOnUnref , -- ** iOChannelGetEncoding iOChannelGetEncoding , -- ** iOChannelGetFlags iOChannelGetFlags , -- ** iOChannelGetLineTerm iOChannelGetLineTerm , -- ** iOChannelInit iOChannelInit , -- ** iOChannelNewFile iOChannelNewFile , -- ** iOChannelRead iOChannelRead , -- ** iOChannelReadLine iOChannelReadLine , -- ** iOChannelReadToEnd iOChannelReadToEnd , -- ** iOChannelReadUnichar iOChannelReadUnichar , -- ** iOChannelRef iOChannelRef , -- ** iOChannelSeek iOChannelSeek , -- ** iOChannelSeekPosition iOChannelSeekPosition , -- ** iOChannelSetBufferSize iOChannelSetBufferSize , -- ** iOChannelSetBuffered iOChannelSetBuffered , -- ** iOChannelSetCloseOnUnref iOChannelSetCloseOnUnref , -- ** iOChannelSetEncoding iOChannelSetEncoding , -- ** iOChannelSetFlags iOChannelSetFlags , -- ** iOChannelSetLineTerm iOChannelSetLineTerm , -- ** iOChannelShutdown iOChannelShutdown , -- ** iOChannelUnixGetFd iOChannelUnixGetFd , -- ** iOChannelUnixNew iOChannelUnixNew , -- ** iOChannelUnref iOChannelUnref , -- ** iOChannelWrite iOChannelWrite , -- ** iOChannelWriteChars iOChannelWriteChars , -- ** iOChannelWriteUnichar iOChannelWriteUnichar , ) where import Prelude () import Data.GI.Base.ShortPrelude import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import GI.GLib.Types import GI.GLib.Callbacks newtype IOChannel = IOChannel (ForeignPtr IOChannel) foreign import ccall "g_io_channel_get_type" c_g_io_channel_get_type :: IO GType instance BoxedObject IOChannel where boxedType _ = c_g_io_channel_get_type noIOChannel :: Maybe IOChannel noIOChannel = Nothing -- method IOChannel::new_file -- method type : Constructor -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOChannel" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_new_file" g_io_channel_new_file :: CString -> -- filename : TBasicType TUTF8 CString -> -- mode : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr IOChannel) iOChannelNewFile :: (MonadIO m) => T.Text -> -- filename T.Text -> -- mode m IOChannel iOChannelNewFile filename mode = liftIO $ do filename' <- textToCString filename mode' <- textToCString mode onException (do result <- propagateGError $ g_io_channel_new_file filename' mode' checkUnexpectedReturnNULL "g_io_channel_new_file" result result' <- (wrapBoxed IOChannel) result freeMem filename' freeMem mode' return result' ) (do freeMem filename' freeMem mode' ) -- method IOChannel::unix_new -- method type : Constructor -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOChannel" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_unix_new" g_io_channel_unix_new :: Int32 -> -- fd : TBasicType TInt32 IO (Ptr IOChannel) iOChannelUnixNew :: (MonadIO m) => Int32 -> -- fd m IOChannel iOChannelUnixNew fd = liftIO $ do result <- g_io_channel_unix_new fd checkUnexpectedReturnNULL "g_io_channel_unix_new" result result' <- (wrapBoxed IOChannel) result return result' -- method IOChannel::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_close" g_io_channel_close :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO () {-# DEPRECATED iOChannelClose ["(Since version 2.2)","Use g_io_channel_shutdown() instead."]#-} iOChannelClose :: (MonadIO m) => IOChannel -> -- _obj m () iOChannelClose _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_io_channel_close _obj' touchManagedPtr _obj return () -- method IOChannel::flush -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_flush" g_io_channel_flush :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Ptr (Ptr GError) -> -- error IO CUInt iOChannelFlush :: (MonadIO m) => IOChannel -> -- _obj m IOStatus iOChannelFlush _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj onException (do result <- propagateGError $ g_io_channel_flush _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' ) (do return () ) -- method IOChannel::get_buffer_condition -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOCondition" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_buffer_condition" g_io_channel_get_buffer_condition :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO CUInt iOChannelGetBufferCondition :: (MonadIO m) => IOChannel -> -- _obj m [IOCondition] iOChannelGetBufferCondition _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_buffer_condition _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method IOChannel::get_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_buffer_size" g_io_channel_get_buffer_size :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO Word64 iOChannelGetBufferSize :: (MonadIO m) => IOChannel -> -- _obj m Word64 iOChannelGetBufferSize _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_buffer_size _obj' touchManagedPtr _obj return result -- method IOChannel::get_buffered -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_buffered" g_io_channel_get_buffered :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO CInt iOChannelGetBuffered :: (MonadIO m) => IOChannel -> -- _obj m Bool iOChannelGetBuffered _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_buffered _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method IOChannel::get_close_on_unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : 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 -> -- _obj : TInterface "GLib" "IOChannel" IO CInt iOChannelGetCloseOnUnref :: (MonadIO m) => IOChannel -> -- _obj m Bool iOChannelGetCloseOnUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_close_on_unref _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method IOChannel::get_encoding -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_encoding" g_io_channel_get_encoding :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO CString iOChannelGetEncoding :: (MonadIO m) => IOChannel -> -- _obj m T.Text iOChannelGetEncoding _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_encoding _obj' checkUnexpectedReturnNULL "g_io_channel_get_encoding" result result' <- cstringToText result touchManagedPtr _obj return result' -- method IOChannel::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOFlags" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_flags" g_io_channel_get_flags :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO CUInt iOChannelGetFlags :: (MonadIO m) => IOChannel -> -- _obj m [IOFlags] iOChannelGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method IOChannel::get_line_term -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_io_channel_get_line_term" g_io_channel_get_line_term :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Int32 -> -- length : TBasicType TInt32 IO CString iOChannelGetLineTerm :: (MonadIO m) => IOChannel -> -- _obj Int32 -> -- length m T.Text iOChannelGetLineTerm _obj length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_get_line_term _obj' length_ checkUnexpectedReturnNULL "g_io_channel_get_line_term" result result' <- cstringToText result touchManagedPtr _obj return result' -- method IOChannel::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_init" g_io_channel_init :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO () iOChannelInit :: (MonadIO m) => IOChannel -> -- _obj m () iOChannelInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_io_channel_init _obj' touchManagedPtr _obj return () -- method IOChannel::read -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_read", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_read", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOError" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_read" g_io_channel_read :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CString -> -- buf : TBasicType TUTF8 Word64 -> -- count : TBasicType TUInt64 Word64 -> -- bytes_read : TBasicType TUInt64 IO CUInt {-# DEPRECATED iOChannelRead ["(Since version 2.2)","Use g_io_channel_read_chars() instead."]#-} iOChannelRead :: (MonadIO m) => IOChannel -> -- _obj T.Text -> -- buf Word64 -> -- count Word64 -> -- bytes_read m IOError iOChannelRead _obj buf count bytes_read = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj buf' <- textToCString buf result <- g_io_channel_read _obj' buf' count bytes_read let result' = (toEnum . fromIntegral) result touchManagedPtr _obj freeMem buf' return result' -- method IOChannel::read_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str_return", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "terminator_pos", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_read_line" g_io_channel_read_line :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Ptr CString -> -- str_return : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr Word64 -> -- terminator_pos : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CUInt iOChannelReadLine :: (MonadIO m) => IOChannel -> -- _obj m (IOStatus,T.Text,Word64,Word64) iOChannelReadLine _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj str_return <- allocMem :: IO (Ptr CString) length_ <- allocMem :: IO (Ptr Word64) terminator_pos <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_io_channel_read_line _obj' str_return length_ terminator_pos let result' = (toEnum . fromIntegral) result str_return' <- peek str_return str_return'' <- cstringToText str_return' freeMem str_return' length_' <- peek length_ terminator_pos' <- peek terminator_pos touchManagedPtr _obj freeMem str_return freeMem length_ freeMem terminator_pos return (result', str_return'', length_', terminator_pos') ) (do freeMem str_return freeMem length_ freeMem terminator_pos ) -- method IOChannel::read_to_end -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str_return", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_read_to_end" g_io_channel_read_to_end :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Ptr (Ptr Word8) -> -- str_return : TCArray False (-1) 2 (TBasicType TUInt8) Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CUInt iOChannelReadToEnd :: (MonadIO m) => IOChannel -> -- _obj m (IOStatus,ByteString) iOChannelReadToEnd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj str_return <- allocMem :: IO (Ptr (Ptr Word8)) length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_io_channel_read_to_end _obj' str_return length_ length_' <- peek length_ let result' = (toEnum . fromIntegral) result str_return' <- peek str_return str_return'' <- (unpackByteStringWithLength length_') str_return' freeMem str_return' touchManagedPtr _obj freeMem str_return freeMem length_ return (result', str_return'') ) (do freeMem str_return freeMem length_ ) -- method IOChannel::read_unichar -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "thechar", argType = TBasicType TUniChar, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_read_unichar" g_io_channel_read_unichar :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Ptr CInt -> -- thechar : TBasicType TUniChar Ptr (Ptr GError) -> -- error IO CUInt iOChannelReadUnichar :: (MonadIO m) => IOChannel -> -- _obj m (IOStatus,Char) iOChannelReadUnichar _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj thechar <- allocMem :: IO (Ptr CInt) onException (do result <- propagateGError $ g_io_channel_read_unichar _obj' thechar let result' = (toEnum . fromIntegral) result thechar' <- peek thechar let thechar'' = (chr . fromIntegral) thechar' touchManagedPtr _obj freeMem thechar return (result', thechar'') ) (do freeMem thechar ) -- method IOChannel::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOChannel" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_ref" g_io_channel_ref :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO (Ptr IOChannel) iOChannelRef :: (MonadIO m) => IOChannel -> -- _obj m IOChannel iOChannelRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_ref _obj' checkUnexpectedReturnNULL "g_io_channel_ref" result result' <- (wrapBoxed IOChannel) result touchManagedPtr _obj return result' -- method IOChannel::seek -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "SeekType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "SeekType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOError" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_seek" g_io_channel_seek :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Int64 -> -- offset : TBasicType TInt64 CUInt -> -- type : TInterface "GLib" "SeekType" IO CUInt {-# DEPRECATED iOChannelSeek ["(Since version 2.2)","Use g_io_channel_seek_position() instead."]#-} iOChannelSeek :: (MonadIO m) => IOChannel -> -- _obj Int64 -> -- offset SeekType -> -- type m IOError iOChannelSeek _obj offset type_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = (fromIntegral . fromEnum) type_ result <- g_io_channel_seek _obj' offset type_' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method IOChannel::seek_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "SeekType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "SeekType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_seek_position" g_io_channel_seek_position :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Int64 -> -- offset : TBasicType TInt64 CUInt -> -- type : TInterface "GLib" "SeekType" Ptr (Ptr GError) -> -- error IO CUInt iOChannelSeekPosition :: (MonadIO m) => IOChannel -> -- _obj Int64 -> -- offset SeekType -> -- type m IOStatus iOChannelSeekPosition _obj offset type_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = (fromIntegral . fromEnum) type_ onException (do result <- propagateGError $ g_io_channel_seek_position _obj' offset type_' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' ) (do return () ) -- method IOChannel::set_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_set_buffer_size" g_io_channel_set_buffer_size :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" Word64 -> -- size : TBasicType TUInt64 IO () iOChannelSetBufferSize :: (MonadIO m) => IOChannel -> -- _obj Word64 -> -- size m () iOChannelSetBufferSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_io_channel_set_buffer_size _obj' size touchManagedPtr _obj return () -- method IOChannel::set_buffered -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffered", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffered", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_set_buffered" g_io_channel_set_buffered :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CInt -> -- buffered : TBasicType TBoolean IO () iOChannelSetBuffered :: (MonadIO m) => IOChannel -> -- _obj Bool -> -- buffered m () iOChannelSetBuffered _obj buffered = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let buffered' = (fromIntegral . fromEnum) buffered g_io_channel_set_buffered _obj' buffered' touchManagedPtr _obj return () -- method IOChannel::set_close_on_unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "do_close", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "do_close", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_set_close_on_unref" g_io_channel_set_close_on_unref :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CInt -> -- do_close : TBasicType TBoolean IO () iOChannelSetCloseOnUnref :: (MonadIO m) => IOChannel -> -- _obj Bool -> -- do_close m () iOChannelSetCloseOnUnref _obj do_close = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let do_close' = (fromIntegral . fromEnum) do_close g_io_channel_set_close_on_unref _obj' do_close' touchManagedPtr _obj return () -- method IOChannel::set_encoding -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "encoding", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "encoding", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_set_encoding" g_io_channel_set_encoding :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CString -> -- encoding : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CUInt iOChannelSetEncoding :: (MonadIO m) => IOChannel -> -- _obj Maybe (T.Text) -> -- encoding m IOStatus iOChannelSetEncoding _obj encoding = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeEncoding <- case encoding of Nothing -> return nullPtr Just jEncoding -> do jEncoding' <- textToCString jEncoding return jEncoding' onException (do result <- propagateGError $ g_io_channel_set_encoding _obj' maybeEncoding let result' = (toEnum . fromIntegral) result touchManagedPtr _obj freeMem maybeEncoding return result' ) (do freeMem maybeEncoding ) -- method IOChannel::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "IOFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "IOFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_set_flags" g_io_channel_set_flags :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CUInt -> -- flags : TInterface "GLib" "IOFlags" Ptr (Ptr GError) -> -- error IO CUInt iOChannelSetFlags :: (MonadIO m) => IOChannel -> -- _obj [IOFlags] -> -- flags m IOStatus iOChannelSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let flags' = gflagsToWord flags onException (do result <- propagateGError $ g_io_channel_set_flags _obj' flags' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' ) (do return () ) -- method IOChannel::set_line_term -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_term", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_term", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_set_line_term" g_io_channel_set_line_term :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CString -> -- line_term : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 IO () iOChannelSetLineTerm :: (MonadIO m) => IOChannel -> -- _obj Maybe (T.Text) -> -- line_term Int32 -> -- length m () iOChannelSetLineTerm _obj line_term length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeLine_term <- case line_term of Nothing -> return nullPtr Just jLine_term -> do jLine_term' <- textToCString jLine_term return jLine_term' g_io_channel_set_line_term _obj' maybeLine_term length_ touchManagedPtr _obj freeMem maybeLine_term return () -- method IOChannel::shutdown -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flush", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flush", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_shutdown" g_io_channel_shutdown :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CInt -> -- flush : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO CUInt iOChannelShutdown :: (MonadIO m) => IOChannel -> -- _obj Bool -> -- flush m IOStatus iOChannelShutdown _obj flush = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let flush' = (fromIntegral . fromEnum) flush onException (do result <- propagateGError $ g_io_channel_shutdown _obj' flush' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' ) (do return () ) -- method IOChannel::unix_get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_io_channel_unix_get_fd" g_io_channel_unix_get_fd :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO Int32 iOChannelUnixGetFd :: (MonadIO m) => IOChannel -> -- _obj m Int32 iOChannelUnixGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_channel_unix_get_fd _obj' touchManagedPtr _obj return result -- method IOChannel::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_channel_unref" g_io_channel_unref :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" IO () iOChannelUnref :: (MonadIO m) => IOChannel -> -- _obj m () iOChannelUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_io_channel_unref _obj' touchManagedPtr _obj return () -- method IOChannel::write -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOError" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_write" g_io_channel_write :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CString -> -- buf : TBasicType TUTF8 Word64 -> -- count : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 IO CUInt {-# DEPRECATED iOChannelWrite ["(Since version 2.2)","Use g_io_channel_write_chars() instead."]#-} iOChannelWrite :: (MonadIO m) => IOChannel -> -- _obj T.Text -> -- buf Word64 -> -- count Word64 -> -- bytes_written m IOError iOChannelWrite _obj buf count bytes_written = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj buf' <- textToCString buf result <- g_io_channel_write _obj' buf' count bytes_written let result' = (toEnum . fromIntegral) result touchManagedPtr _obj freeMem buf' return result' -- method IOChannel::write_chars -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TCArray False (-1) (-1) (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf", argType = TCArray False (-1) (-1) (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_write_chars" g_io_channel_write_chars :: Ptr IOChannel -> -- _obj : TInterface "GLib" "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 iOChannelWriteChars :: (MonadIO m) => IOChannel -> -- _obj Ptr Word8 -> -- buf Int64 -> -- count m (IOStatus,Word64) iOChannelWriteChars _obj buf count = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj bytes_written <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_io_channel_write_chars _obj' buf count bytes_written let result' = (toEnum . fromIntegral) result bytes_written' <- peek bytes_written touchManagedPtr _obj freeMem bytes_written return (result', bytes_written') ) (do freeMem bytes_written ) -- method IOChannel::write_unichar -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "thechar", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "thechar", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOStatus" -- throws : True -- Skip return : False foreign import ccall "g_io_channel_write_unichar" g_io_channel_write_unichar :: Ptr IOChannel -> -- _obj : TInterface "GLib" "IOChannel" CInt -> -- thechar : TBasicType TUniChar Ptr (Ptr GError) -> -- error IO CUInt iOChannelWriteUnichar :: (MonadIO m) => IOChannel -> -- _obj Char -> -- thechar m IOStatus iOChannelWriteUnichar _obj thechar = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let thechar' = (fromIntegral . ord) thechar onException (do result <- propagateGError $ g_io_channel_write_unichar _obj' thechar' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' ) (do return () )